|
▼マクロ勉強中です。。 さん:
Sub test()
Dim d As Object, a1 As Object, a2 As Object
Dim r As Range, c As Range
Dim e
If TypeName(Selection) <> "Range" Then Exit Sub
Set r = Selection
If r.Columns.Count > 1 Then Exit Sub
If WorksheetFunction.CountA(r) = 0 Then Exit Sub
r.Columns(2).ClearContents
Set d = CreateObject("scripting.dictionary")
Set a1 = CreateObject("system.collections.arraylist")
Set a2 = CreateObject("system.collections.arraylist")
For Each c In r
For Each e In Split(c.Value, " ")
If Not d.exists(e) Then
d(e) = True
a1.Add e
End If
Next
If a1.Count > 0 Then
a2.Add Join(a1.toarray, " ")
a1.Clear
End If
Next
r(1, 2).Resize(a2.Count).Value = WorksheetFunction.Transpose(a2.toarray)
End Sub
|
|