感觉问题不是很严谨啊,是我想多了吗
Sub 问题()
Dim dic, r, drr, arr, d
Set dic = CreateObject("scripting.dictionary")
arr = Range("a1:b" & Cells(Rows.Count, 2).End(xlUp).Row)
For r = 2 To Cells(Rows.Count, 2).End(xlUp).Row
dic(Cells(r, 1).Value) = dic(Cells(r, 1).Value) & "," & r
Next
Cells(1, 6).Resize(1, dic.Count) = dic.keys
C = Cells(1, 6).End(xlToRight).Column
Range(Cells(1, 6), Cells(1, C)).Sort key1:=Range("E1"), order1:=1, Header:=xlGuess, Orientation:=xlLeftToRight
For r = 6 To C
drr = Split(dic(Cells(1, r).Value), ",")
For d = 1 To UBound(drr, 1)
Cells(drr(d), r) = arr(drr(d), 2)
Next
Next
End Sub