- 帖子
- 976
- 主題
- 7
- 精華
- 0
- 積分
- 1018
- 點名
- 0
- 作業系統
- Win10
- 軟體版本
- Office 2016
- 閱讀權限
- 50
- 性別
- 男
- 註冊時間
- 2013-4-19
- 最後登錄
- 2026-5-26
|
回復 3# ziv976688
請再確認是否為您的需求,感謝。
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 |
|