Sub aa()
Dim rng As Range
Dim str As String
Dim irng As Range
Set d = CreateObject("scripting.dictionary")
For i = 2 To Range("b65536").End(3).Row
d(Cells(i, 1).Value) = "1"
Next i
k = d.keys
For i = 0 To d.Count - 1
m = 2
Set rng = ActiveSheet.Columns("a").Find(what:=k(i), lookat:=xlWhole)
If Not rng Is Nothing Then
str = rng.Address
Set irng = rng
End If
Do
m = m + 1
Set rng = ActiveSheet.Columns("a").FindNext(rng)
If rng.Address <> str Then
Rows(rng.Row).Select
Selection.SpecialCells(xlCellTypeConstants, 1).Copy
irng.Offset(0, m).Select
ActiveSheet.Paste
End If
Loop While Not rng Is Nothing And rng.Address <> str
Next
End Sub
容错率高 放心使用 所有数据都会统计在名称第一次出现的那一行内。
本回答被提问者采纳