- 帖子
- 1425
- 主題
- 40
- 精華
- 0
- 積分
- 1449
- 點名
- 0
- 作業系統
- Windows 7
- 軟體版本
- Excel 2010 & 2016
- 閱讀權限
- 50
- 性別
- 男
- 來自
- 台灣
- 註冊時間
- 2020-7-15
- 最後登錄
- 2024-4-16
|
本帖最後由 Andy2483 於 2023-11-9 15:47 編輯
謝謝論壇,謝謝各位前輩
後學藉此帖以1#範例檔(question1.zip) 練習陣列.字典與邏輯值運算,學習方案如下,請各位前輩指教
資料表:
執行結果:
Option Explicit
Sub TEST()
Dim Brr, Crr, Z, V&, Q&, R&, i&, ii&, j%, T$, T1$
Set Z = CreateObject("Scripting.Dictionary")
Brr = Range([M2], [L65536].End(xlUp))
For i = 1 To UBound(Brr): Z(Format(Brr(i, 1), "000")) = Val(Brr(i, 2)): Next
Brr = Range([I1], [A65536].End(xlUp)(2))
ReDim Crr(1 To 10000, 1 To 9)
For j = 1 To 9: Crr(1, j) = Brr(1, j): Next: R = 1
For i = 2 To UBound(Brr) - 1
T = Format(Brr(i, 4), "000"): T1 = Format(Brr(i + 1, 4), "000")
V = Z(T): Q = Brr(i, 8)
For ii = 0 To Q \ V
R = R + 1
For j = 1 To 9: Crr(R, j) = Brr(i, j): Next
Crr(R, 4) = "'" & T
Crr(R, 6) = V * ii + 1
Crr(R, 7) = V * (ii - (ii <> Q \ V)) - (ii = Q \ V) * (Q Mod V)
Crr(R, 8) = V * -(ii <> Q \ V) - (ii = Q \ V) * (Q Mod V)
Next
If T <> T1 Then R = (((R - 1) \ 4) - ((R - 1) Mod 4 <> 0)) * 4 + 1
Next
Workbooks.Add
[A1].Resize(R, 9) = Crr
Set Z = Nothing: Erase Brr, Crr
End Sub |
|
發表於 2023-11-9 15:36
| 