ITコンサルの日常

ITコンサル会社に勤務する普通のITエンジニアの日常です。

ExcelでDISTINCT(マクロ編)

以前書いた、ExcelでDISTINCTなんですが、通りすがりさんに教えてもらった方法で簡単に出来ることが分かりました。
が、一応Excelマクロでやる方法も、何かの参考になるかも知れないのでメモしておきます。
以下のサンプルは、選択範囲から重複を取り除き、新しいブックの1列目に結果を貼り付けるというものです。
これだと複数列も対象に出来ますし、列全体でなくても、選択した行のみ対象に出来ます。(そういう用途があるかどうかは別にして)

Sub DistinctCells()
    ' 選択範囲を対象とする
    Set targetRange = Selection
    Set dict = CreateObject("Scripting.Dictionary")

    rowNum = targetRange.Rows.Count
    columnNum = targetRange.Columns.Count

    ' 選択範囲を操作し、重複を排除しながらDictionaryオブジェクトに格納する
    For i = 1 To rowNum
        For j = 1 To columnNum
            If dict.exists(Cells(i, j).Value) = False Then
                dict.Add Cells(i, j).Value, "X"
            End If
        Next
    Next

    ' 新しいブックを作成する
    Set newBook = Workbooks.Add
    Set NewSheet = newBook.Sheets(1)

    ' 新しいブックの1列目に結果を貼り付ける
    currentRow = 1
    For Each key In dict.keys
        NewSheet.Cells(currentRow, 1) = key
        currentRow = currentRow + 1
    Next
End Sub