|
Dictionaryオブジェクトを使用して重複をなくしてます。
Sub test()
Dim DIC As Object
Dim r As Range, rr As Range
Dim v, vv
Set DIC = CreateObject("Scripting.Dictionary")
For Each r In Range([A10], Cells(10, Columns.Count).End(xlToLeft))
Set rr = Range(Cells(10, r.Column), Cells(Rows.Count, r.Column).End(xlUp))
v = rr.Value
For Each vv In v
If Not DIC.exists(vv) Then
DIC(vv) = Empty
End If
Next
rr.ClearContents
Cells(10, r.Column).Resize(DIC.Count).Value = Application.Transpose(DIC.keys)
DIC.RemoveAll
Next
End Sub
ご参考になれば幸いです。
|
|