text 字典嵌套2018年2月8日

Posted 2021-05-03

Sub test()
Dim arr, i%, j%, d, s, sd$
sd = "scripting.dictionary"
Set d = CreateObject(sd)
arr = [a1].CurrentRegion
For i = 2 To UBound(arr)
    For j = 2 To UBound(arr, 2)
        If arr(i, j) <> "" Then
            If d.exists(arr(i, j)) = 0 Then
                Set d(arr(i, j)) = CreateObject(sd)
            End If
            d(arr(i, j))(arr(i, 1)) = ""
        End If
    Next j
Next i
[a8].Resize(d.Count) = Application.Transpose(d.keys)
s = d.items
For i = 0 To d.Count - 1
    [b8].Offset(i).Resize(1, s(i).Count) = s(i).keys
Next i
End Sub