Sub ex()
Dim d As Object
Dim a, x%
Set d = CreateObject("Scripting.Dictionary")
For Each a In Range([c2], [c65535].End(3))
For x = 1 To 20
If a.Offset(, x).Value <> "" Then
If Not d.exists(a.Offset(, x).Value) Then
d(a.Offset(, x).Value) = a
Else
d(a.Offset(, x).Value) = d(a.Offset(, x).Value) + a
End If
Else: Exit For
End If
Next
Next
For Each a In Range("AB1:BU1")
If d.exists(a.Value) Then a.Offset(1) = d(a.Value)
Next
Set d = Nothing
End Sub作者: samwang 時間: 2020-11-30 13:31
Sub tt()
Dim Arr, xD, Drr, i&, j&, s%
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range([Z1], [C65536].End(3))
For i = 2 To UBound(Arr)
For j = 2 To UBound(Arr, 2)
T = Arr(i, j)
If T = "" Then GoTo 100
xD(T) = xD(T) + Arr(i, 1)
100: Next
Next
Drr = Range([AB1], [AB1].End(2))
For j = 1 To UBound(Drr, 2)
T1 = Drr(1, j)
Drr(1, j) = xD(T1)
s = s + 1
Next
Range("AB2").Resize(, s) = Drr
End Sub作者: ziv976688 時間: 2020-11-30 14:27