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