縦列をループして重複データのみ隣の列に抽出
指定された範囲の縦列に含まれる重複を削除し、隣の列に一意の値を出力する
Sub 縦列の重複なしのユニークデータを隣列に表記()
Dim dic, i As Long, buf As String, Keys
Set dic = CreateObject("Scripting.Dictionary")
On Error Resume Next
For i = 2 To ThisWorkbook.ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
buf = Cells(i, 1).Value
dic.Add buf, buf
Next i
'出力
Keys = dic.Keys
For i = 0 To dic.Count - 1
Cells(i + 2, 2) = Keys(i)
Next i
Set dic = Nothing
MsgBox "完了"
End Sub解説
- 変数の宣言
- 最初に、Scripting.Dictionaryオブジェクトを宣言しています。このオブジェクトは、重複を削除して一意の値を格納するために使用されます。iとbufという2つの整数変数も宣言されています。
- Scripting.Dictionaryに重複のない値を追加
- 指定された範囲の縦列に含まれる値をbufに代入し、Scripting.Dictionaryオブジェクトに値を追加します。このオブジェクトに値が重複している場合、エラーが発生します。これを回避するために、On Error Resume Nextが使用されています。
- 一意の値を隣列に出力
- Scripting.Dictionaryオブジェクトに格納されている値をKeysに代入し、Forループを使用して、一意の値を隣列に出力します。最後に、Scripting.Dictionaryオブジェクトをクリアして、MsgBoxで処理の完了を知らせます。
- 最後の行では、
Set dic = Nothingを使用して、Scripting.Dictionaryオブジェクトを解放しています。
重複しているセルを含む行をカラーで表示する
Excelシート内の重複したセルを含む行を特定し、その行をカラーで表示するマクロです
Sub 重複しているセルの行をカラー表示()
’アクティブなセルの右に新しい列を追加
ActiveCell.Offset(0, 1).EntireColumn.Insert
Dim maxRow As Long
maxRow = ThisWorkbook.ActiveSheet.Cells(Rows.Count, 3).End(xlUp).Row
Dim i As Long
For i = 1 To maxRow
If WorksheetFunction.CountIf(Range("A1:A" & maxRow), Cells(i, 1)) > 1 Then
Cells(i, 1).Font.ColorIndex = 3
Cells(i, 1).EntireRow.Interior.Color = RGB(204, 255, 255)
End If
Next i
MsgBox "完了"
End Sub解説
このVBAコードは、Excelシートの列Aで重複した値を強調表示する方法を示しています。具体的には、 ActiveCell.Offset(0, 1).EntireColumn.Insert を使用して、アクティブセルの右側に1つの列を挿入し、列Bにデータを書き込む準備をします。
2行目は、 maxRow 変数を宣言し、列Cの最終行を計算します。これは、データの最後の行を検出するために使用されます。
3行目から9行目は、列1の各行の値を検証し、重複している場合に対応するためのループです。 CountIf 関数を使用して、列1の範囲内で現在のセルの値が何回出現するかを数え、重複した値がある場合には、そのセルと同じ行全体を強調表示します。セルのフォント色を赤（ ColorIndex = 3 ）に設定し、セルの背景色をライトブルーに設定します（ RGB(204, 255, 255) ）。
10行目から11行目は、ループの終了を示しています。
このコードを使用する前に、強調表示されるセルのフォント色や背景色を変更したい場合は、適宜変更してください。また、セルの範囲が異なる場合は、 Range 関数の引数を変更する必要があります。
コメント