Excelの基本的な機能で、重複する行を削除することができますが、重複する列を削除することはできないようです。
やりたいこと
下記のように、A行の重複を削除したり、B行の重複を削除したりする
1行に対して重複列を削除
選択範囲 (1行) の重複列を削除します。
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
複数行に対して重複列を削除
複数行に対して一括で処理を行う場合は、重複削除の基準とする行を一つ選ぶ仕様になります。
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')
→ このエラーを生じさせないためには、使用していない行が十分にない場合、処理を行わないなどのエラー処理が必要。
参考