0
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

More than 3 years have passed since last update.

Excelで重複削除 (重複列を削除する)

Last updated at Posted at 2021-09-05

Excelの基本的な機能で、重複する行を削除することができますが、重複する列を削除することはできないようです。

やりたいこと

下記のように、A行の重複を削除したり、B行の重複を削除したりする
列重複削除.jpg

1行に対して重複列を削除

選択範囲 (1行) の重複列を削除します。

  1. 重複列を削除したい範囲を選択
    image.png

  2. マクロ (下記のVBAコードを実行) の処理結果
    image.png

module1.bas
'水平方向に重複削除 (先頭行基準)
Public Sub removeDeplicatesHorizontal()
    Dim rng As Range, rngNotUsed As Range
    Set rng = Selection '選択範囲をrngオブジェクトに格納
    Set rng = rng.Rows(1)
    rng.Select
    
    With ActiveSheet.UsedRange
        Set rngNotUsed = Range(Cells(.Rows(.Rows.Count).Row + 1, 1), _
        Cells(.Rows(.Rows.Count).Row + rng.Columns.Count, 1)) '使用していない領域をrngNotUsedオブジェクトに設定
    End With
    rngNotUsed = WorksheetFunction.Transpose(rng) 'rngオブジェクトの行/列を入れ替えてrngNotUsedオブジェクトに貼り付け    
    rngNotUsed.RemoveDuplicates Columns:=1 'Excel標準機能で、重複行を削除

    rng.Clear 
    rng = WorksheetFunction.Transpose(rngNotUsed) 'rngNotUsedオブジェクトの行/列を入れ替えてrngオブジェクトに貼り付け
    rngNotUsed.Clear

End Sub

複数行に対して重複列を削除

複数行に対して一括で処理を行う場合は、重複削除の基準とする行を一つ選ぶ仕様になります。

  1. 重複列を削除したい範囲を選択
    image.png

  2. 重複を判断する基準の行を1つ選択
    例として、2行目を基準にします。
    image.png

  3. 実行結果
    image.png

module2.bas
'水平方向に重複削除 (n行目基準)
Public Sub removeDeplicatesHorizontalMultiple()
    
    Dim rng As Range, rngNotUsed As Range, c As Long, i As Long, n As Long, s As String
    Set rng = Selection

    c = rng.Rows.Count
    If c > 1 Then
        s = InputBox("重複削除の基準を何行目にしますか?", , 1)
        If IsNumeric(s) Then
            n = WorksheetFunction.Min(CLng(s), c)
        Else
            n = 1
            Set rng = rng.Rows(1)
            rng.Select
        End If
    Else
        n = 1
        Set rng = rng.Rows(1)
        rng.Select
    End If
    
    With ActiveSheet.UsedRange
        Set rngNotUsed = Range(Cells(.Rows(.Rows.Count).Row + 1, 1), _
        Cells(.Rows(.Rows.Count).Row + rng.Columns.Count, c))
    End With
    rngNotUsed = WorksheetFunction.Transpose(rng)
    rngNotUsed.RemoveDuplicates Columns:=n
    
    rng.Clear
    rng = WorksheetFunction.Transpose(rngNotUsed)
    rngNotUsed.Clear

End Sub

注意点

  • 書式などは消えてしまう → rng.Clear を rng.ClearContentsと書き換えれば、書式は消えないが、古い書式が残ることで別の問題が起きる可能性に注意する必要あり
  • Activesheetに、使用していない行が、十分に存在しないとエラーになってしまう (実行時エラー'1004')
    image.png

→ このエラーを生じさせないためには、使用していない行が十分にない場合、処理を行わないなどのエラー処理が必要。

参考

0
0
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
0
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?