Sub test()
Dim A, B, d, i%, j%, s, x
Sheets(1).Select
A = Range("a1:k" & Range("a65536").End(xlUp).Row)
ReDim B(1 To UBound(A), 1 To UBound(A, 2))
Set d = CreateObject("scripting.dictionary")
For i = 1 To UBound(A)
x = A(i, 5) 'key
If x <> "" Then
If d.exists(x) Then
'已存在
For j = 1 To UBound(A, 2)
If B(d(x), j) = "" Then B(d(x), j) = A(i, j)
Next j
Else
'不存在
s = s + 1: d(x) = s
For j = 1 To UBound(A, 2)
B(s, j) = A(i, j)
Next j
End If
End If
Next i
Cells.Delete
If s Then [a1].Resize(s, UBound(B, 2)) = B
End Sub
这样可以吗