|
▼マクロ勉強中です。。 さん:
Sub test2()
Dim d As Object, d2 As Object, d3 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 d2 = CreateObject("scripting.dictionary")
Set d3 = CreateObject("scripting.dictionary")
For Each c In r
For Each e In Split(c.Value, " ")
If Not d.exists(e) Then
d(e) = True
d2(e) = True
End If
Next
If d2.Count > 0 Then
d3(d3.Count) = Join(d2.keys, " ")
d2.RemoveAll
End If
Next
r(1, 2).Resize(d3.Count).Value = WorksheetFunction.Transpose(d3.items)
End Sub
|
|