- 帖子
- 1446
- 主題
- 40
- 精華
- 0
- 積分
- 1470
- 點名
- 0
- 作業系統
- Windows 7
- 軟體版本
- Excel 2010 & 2016
- 閱讀權限
- 50
- 性別
- 男
- 來自
- 台灣
- 註冊時間
- 2020-7-15
- 最後登錄
- 2024-10-21
|
12#
發表於 2023-6-5 16:11
| 只看該作者
謝謝論壇,謝謝各位前輩
後學藉此帖練習陣列與字典,學習1#範例方案如下,請各位前輩指教
執行前:
執行結果:
Option Explicit
Sub TEST_1()
Dim Brr, Crr, Y, R&, i&, j%, N&, T1$, T2$, V1&, V2&
Set Y = CreateObject("Scripting.Dictionary")
[E2:F2000].ClearContents
Brr = Range([B7], Cells(Rows.Count, 1).End(3))
ReDim Crr(1 To UBound(Brr), 1 To 2)
For i = 1 To UBound(Brr)
T1 = Brr(i, 1): T2 = Brr(i, 2)
If T1 = "" Or Val(T2) = 0 Then GoTo i01
V1 = Val(T2): V2 = StrReverse(Split(StrReverse(T2), "-")(0))
For j = V1 To V2
If Y(T1) = "" Then N = N + 1: Y(T1) = N: Crr(N, 1) = T1
If Y(T1 & j) = "" Then
R = Y(T1): Y(T1 & j) = 1: Crr(R, 2) = Crr(R, 2) + 1
End If
Next
i01: Next
If N > 0 Then [E2].Resize(N, 2) = Crr
Set Y = Nothing: Erase Brr, Crr
End Sub |
|
