- 帖子
- 1446
- 主題
- 40
- 精華
- 0
- 積分
- 1470
- 點名
- 0
- 作業系統
- Windows 7
- 軟體版本
- Excel 2010 & 2016
- 閱讀權限
- 50
- 性別
- 男
- 來自
- 台灣
- 註冊時間
- 2020-7-15
- 最後登錄
- 2024-11-28
|
12#
發表於 2023-5-31 14:54
| 只看該作者
本帖最後由 Andy2483 於 2023-5-31 15:07 編輯
謝謝論壇,謝謝各位前輩
後學藉此帖練習陣列與字典,學習8#樓範例方案如下,請各位前輩指教
AA表執行前:
載至AA表_執行結果:
AA表_使用者執行儲存格編輯:
寫入QQ表_執行結果:
Option Explicit
Public K%
Sub TEST()
Dim Qrr, Arr, Y, Z, i&, j&, T1$, T2$, TT$
Dim Q As Range, A As Range, Shq As Worksheet, Sha As Worksheet
Set Y = CreateObject("Scripting.Dictionary")
Set Sha = Sheets("AA"): Set Shq = Sheets("QQ")
Set Q = Range(Shq.[A1], Shq.UsedRange): Qrr = Q
For i = 1 To UBound(Qrr, 1) Step 19
For j = 2 To UBound(Qrr, 2) Step 9
T1 = Qrr(i, j): T2 = Qrr(i, j + 1): TT = T1 & "|" & T2
If T1 = "" Or T2 = "" Then GoTo j01
Set Y(TT) = Range(Q(i, j - 1), Q(i + 18, j + 7))
Y(TT & "|v") = Y(TT)
j01: Next
Next
Set A = Sha.[B1:J19]: Arr = A
T1 = Arr(1, 2): T2 = Arr(1, 3): TT = T1 & "|" & T2
If K = 1 Then A = Y(TT & "|v")
If K = 2 Then Set Q = Y(TT): Q = Arr
Set Y = Nothing: Set Q = Nothing: Set A = Nothing
Set Sha = Nothing: Set Shq = Nothing: Erase Qrr, Arr
End Sub
'================================
Sub 載至AA表()
K = 1: Call TEST
End Sub
'================================
Sub 寫入QQ表()
K = 2: Call TEST
End Sub |
|
