- 帖子
- 2834
- 主題
- 10
- 精華
- 0
- 積分
- 2890
- 點名
- 0
- 作業系統
- 〔略〕
- 軟體版本
- 〔略〕
- 閱讀權限
- 100
- 性別
- 男
- 來自
- 〔略〕
- 註冊時間
- 2013-5-13
- 最後登錄
- 2024-11-25
|
2#
發表於 2019-8-4 14:57
| 只看該作者
Sub TEST()
Dim Arr, xD, i&, j&, A$, B, T$, N&
[E2:F2000].ClearContents
Arr = Range([B6], [A65536].End(xlUp))
Set xD = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(Arr)
A = Arr(i, 1): B = Arr(i, 2)
If A = "" Or Val(B) = 0 Then GoTo 101
If xD(A) = 0 Then N = N + 1: xD(A) = N: Arr(N, 1) = A: Arr(N, 2) = 0
B = Split(B & "-" & B, "-")
For j = B(0) To B(1)
T = A & "/" & j: xD(T) = xD(T) + 1
If xD(T) = 1 Then Arr(xD(A), 2) = Arr(xD(A), 2) + 1
Next j
101: Next
If N > 0 Then [E2:F2].Resize(N) = Arr
End Sub |
|
發表於 2019-8-4 16:22
| 
