'也可以在输出之前你指定想要的结果,,,
Option Explicit
Sub test()
Dim arr, i, j, m, t, dic
Set dic = CreateObject("scripting.dictionary")
arr = [a1].CurrentRegion.Offset(1)
For i = 1 To UBound(arr, 1) - 1
dic(arr(i, 1)) = dic(arr(i, 1)) & "," & arr(i, 2)
Next
ReDim brr(1 To UBound(arr, 1), 1 To 3)
For Each i In dic.keys
t = Split(dic(i), ",")
For j = 1 To UBound(t)
m = m + 1
brr(m, 1) = i: brr(m, 2) = j: brr(m, 3) = t(j)
Next
Next
With [k1]
.Resize(Rows.Count, UBound(brr, 2)).ClearContents
.Resize(m, UBound(brr, 2)) = brr
End With
End Sub |