[發問] 雙迴圈或多迴圈 寫法

fantersy

各位先進、大大好
小弟有一VBA雙迴圈問題 想了很久都無法寫出正確答案
是否方便提供相關寫法供參考學習?
VBA執行流程如下
1.庫存分頁抓出數據，只要倉庫編號為JMZ1的料件編號都先讀取起來。
2.分頁axmr450 抓取數據，讀取相同料號並把數量減去總出貨數量。(我卡住的地方)
3.訂單未交分頁，將有顯示出來的料號C欄位填入 未交訂單數量
*訂單未交數量=axmr450的結果-庫存JMZ1的結果
有使用樞紐的邏輯進行驗算，並套用在訂單未交分頁(答案)，邏輯可以參考樞紐分頁

小弟的邏輯真的不好，想了好天都寫不出來
檔案內容有小弟寫到一半的程式語法
真心想學但力不從心，懇請賜教
謝謝!!:)
訂單未交計算.zip (793.79 KB)

下載次數: 9

2023-10-4 19:57

Andy2483

回復 1# fantersy


    謝謝前輩發表此主題與範例
後學藉此帖練習陣列與字典,學習方案如下,請前輩參考

以字典記住計算必要資料,再倒出做計算:

Option Explicit
Sub TEST()
Dim Brr, Crr, Drr, Z, i&, T$
Crr = Range([axmr450!R1], [axmr450!A65536].End(3))
Drr = Range([庫存!G1], [庫存!A65536].End(3))
Brr = Range([訂單未交!B3], [訂單未交!B65536].End(3))
Set Z = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(Drr)
   T = Trim(Drr(i, 5)) & "|" & Trim(Drr(i, 1))
   Z(T) = Z(T) + Val(Drr(i, 6))
Next
For i = 2 To UBound(Crr)
   T = Trim(Crr(i, 7))
   Z(T & "|數量") = Z(T & "|數量") + Val(Crr(i, 10))
   Z(T & "|總出") = Z(T & "|總出") + Val(Crr(i, 18))
Next
For i = 1 To UBound(Brr)
   T = Brr(i, 1)
   Brr(i, 1) = Z(T & "|數量") - Z(T & "|總出") - Z("JMZ1" & "|" & T)
Next
[訂單未交!G3].Resize(UBound(Brr), 1) = Brr
Set Z = Nothing: Erase Brr, Drr, Crr
End Sub
==============================
補充:
範例中有1萬多個不可見的 文字框或圖片....
Sub 刪除物件()
With ActiveSheet.DrawingObjects     
   If .Count > 0 Then MsgBox .Count: .Delete
End With
End Sub

============================
補充另一解法: (以字典記住料號所在的陣列索引列號)

Option Explicit
Sub TEST_1()
Dim Brr, Crr, Drr, Z, i&, T$
Crr = Range([axmr450!R1], [axmr450!A65536].End(3))
Drr = Range([庫存!G1], [庫存!A65536].End(3))
Brr = Range([訂單未交!B3], [訂單未交!B65536].End(3))
Set Z = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(Brr): Z(Brr(i, 1)) = i: Brr(i, 1) = 0: Next
For i = 2 To UBound(Crr)
   T = Trim(Crr(i, 7))
   If Z(T) <> "" Then Brr(Z(T), 1) = Brr(Z(T), 1) + Val(Crr(i, 10)) - Val(Crr(i, 18))
Next
For i = 2 To UBound(Drr)
   T = Trim(Drr(i, 1))
   If Trim(Drr(i, 5)) = "JMZ1" And Z(T) <> "" Then Brr(Z(T), 1) = Brr(Z(T), 1) - Val(Drr(i, 6))
Next
[訂單未交!G3].Resize(UBound(Brr), 1) = Brr
Set Z = Nothing: Erase Brr, Drr, Crr
End Sub

fantersy

回復 2# Andy2483


    感謝協助與幫忙
有些語法對我來說略為有些難度
需要時間理解一下
再次感謝

singo1232001

回復 3# fantersy


   

下載 (117.06 KB)

2023-10-6 15:45

我求出來的答案不同

Sub test()
Set CN = CreateObject("adodb.connection"): V = Application.Version
If V >= 12 Then V = "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0;"
If V < 12 Then V = "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Excel 8.0;"
CN.Open V & "Data Source=" & ThisWorkbook.FullName
Set s = Sheets("訂單未交")
s.[G:AZ].ClearContents

q = ""
q = q & "select 產品編號,(數量 - 總出貨數量) from [axmr450$A1:T] where 產品編號 in( "
q = q & "select 料件編號 from [庫存$A1:G] where 倉庫編號 like '%JMZ1%' "
q = q & " )"
Set RS = CN.Execute(q)
s.[G3].CopyFromRecordset RS

q = ""
q = q & "select 產品編號,sum(dif) from ("
q = q & "select 產品編號,(數量 - 總出貨數量) as dif from [axmr450$A1:T] where 產品編號 in( "
q = q & "select 料件編號 from [庫存$A1:G] where 倉庫編號 like '%JMZ1%' "
q = q & " ) "
q = q & " ) group by 產品編號"
Set RS = CN.Execute(q)
s.[J3].CopyFromRecordset RS

q = ""
q = q & "select t3.料號,t3.料號數總和 from  ( "
q = q & "select * from [訂單未交$B2:B] as t1 left join ( "
q = q & "select 產品編號,sum(dif) as 料號數總和 from ( "
q = q & "select 產品編號,(數量 - 總出貨數量) as dif from [axmr450$A1:T] where 產品編號 in( "
q = q & "select 料件編號 from [庫存$A1:G] where 倉庫編號 like '%JMZ1%' "
q = q & " ) "
q = q & " ) group by 產品編號 "
q = q & " ) as t2 on t1.料號 = t2.產品編號 "
q = q & " ) as t3"
Set RS = CN.Execute(q)
s.[M3].CopyFromRecordset RS

s.[G2:N2] = Array("axmr所有", "逐項差數", "", "合併", "未交總數", "", "對照未交", "未交數")
End Sub

訂單未交計算.zip (798.13 KB)

下載次數: 3

2023-10-6 15:47

singo1232001

回復 4# singo1232001


避免過於程序過長精簡
Sub test2精簡版()
Set CN = CreateObject("adodb.connection"): V = Application.Version
If V >= 12 Then V = "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0;"
If V < 12 Then V = "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Excel 8.0;"
CN.Open V & "Data Source=" & ThisWorkbook.FullName
Set s = Sheets("訂單未交"): s.[C3:C9999].ClearContents
q = "select t2.料數和 from [訂單未交$B2:B] as t1 left join ( "
q = q & "select 產品編號,IIf(IsNull(sum(dif)), 0, sum(dif)) as 料數和 from ( "
q = q & "select 產品編號,(數量 - 總出貨數量) as dif from [axmr450$A1:T] where 產品編號 in( "
q = q & "select 料件編號 from [庫存$A1:G] where 倉庫編號 like '%" & s.[c1] & "%' "
q = q & " ) "
q = q & " ) group by 產品編號 "
q = q & " ) as t2 on t1.料號 = t2.產品編號 "
s.[c3].CopyFromRecordset CN.Execute(q)
End Sub

------------------------------------------------------
Sub test3逐步推進精簡版()
Set CN = CreateObject("adodb.connection"): V = Application.Version
If V >= 12 Then V = "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0;"
If V < 12 Then V = "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Excel 8.0;"
CN.Open V & "Data Source=" & ThisWorkbook.FullName
Set s = Sheets("訂單未交"): s.[G:AZ].ClearContents

    q = "select 產品編號,(數量 - 總出貨數量) as dif from [axmr450$A1:T] where 產品編號 in( "
q = q & "select 料件編號 from [庫存$A1:G] where 倉庫編號 like '%" & s.[c1] & "%' "
p = q & " ) "
s.[G3].CopyFromRecordset CN.Execute(p)

    q = "select 產品編號,IIf(IsNull(sum(dif)), 0, sum(dif)) as 料數和 from ( " & p
p = q & " ) group by 產品編號 "
s.[J3].CopyFromRecordset CN.Execute(p)

    q = "select t1.料號,t2.料數和  from [訂單未交$B2:B] as t1 left join ( " & p
p = q & " ) as t2 on t1.料號 = t2.產品編號 "
s.[M3].CopyFromRecordset CN.Execute(p)

s.[G2:N2] = Array("axmr所有", "逐項差數", "", "合併", "未交總數", "", "對照未交", "未交數")
End Sub


可在C1輸入查詢編號
訂單未交計算 v1.zip (802.92 KB)

下載次數: 4

2023-10-7 23:27

Andy2483

回復 3# fantersy


    謝謝前輩回復
以下是複習心得註解,請前輩參考

Sub TEST_1()
Dim Brr, Crr, Drr, Z, i&, T$
'↑宣告變數:(Brr, Crr, Drr, Z)是通用型變數,i是長整數,T是字串變數
Crr = Range([axmr450!R1], [axmr450!A65536].End(3))
'↑令Crr變數是二維陣列,以"axmr450"工作表[R1]到A欄最後有內容儲存格值帶入
Drr = Range([庫存!G1], [庫存!A65536].End(3))
'↑令Drr變數是二維陣列,以 "庫存"工作表[G1]到A欄最後有內容儲存格值帶入
Brr = Range([訂單未交!B3], [訂單未交!B65536].End(3))
'↑令Brr變數是二維陣列,以 "訂單未交"工作表[B3]到B欄最後有內容儲存格值帶入
Set Z = CreateObject("Scripting.Dictionary")
'↑令Z變數是字典
For i = 1 To UBound(Brr): Z(Brr(i, 1)) = i: Brr(i, 1) = 0: Next
'↑設順迴圈!從1到Brr陣列縱向最大索引列號
'令i迴圈列第1欄Brr陣列值當key,item是i變數,納入Z字典中
'令i迴圈列第1欄Brr陣列值=0
For i = 2 To UBound(Crr)
'↑設順迴圈!從1到Crr陣列縱向最大索引列號
   T = Trim(Crr(i, 7))
   '↑令T變數是 去除頭尾空白字元(i迴圈列第7欄Crr陣列值)的字串
   If Z(T) <> "" Then Brr(Z(T), 1) = Brr(Z(T), 1) + Val(Crr(i, 10)) - Val(Crr(i, 18))
   '↑如果以T變數查Z字典回傳item值不是空字元!
   '就令T變數查Z字典回傳item(原T變數在Brr陣列所在的列號)
   '令該列號第1欄Brr陣列值+Val函數值(i迴圈列10欄Crr陣列值)-Val函數值(i迴圈列18欄Crr陣列值)
Next
For i = 2 To UBound(Drr)
   T = Trim(Drr(i, 1))
   '↑令T變數是 去除頭尾空白字元(i迴圈列第1欄Drr陣列值)的字串
   If Trim(Drr(i, 5)) = "JMZ1" And Z(T) <> "" Then Brr(Z(T), 1) = Brr(Z(T), 1) - Val(Drr(i, 6))
   '↑如果i迴圈列第5欄Drr陣列值經去除頭尾空白字元後的字串="JMZ1"!
   '而且以T變數查Z字典回傳值不是空字元!
   '就令T變數查Z字典回傳item(原T變數在Brr陣列所在的列號)
   '令該列號第1欄Brr陣列值-Val函數值(i迴圈列6欄Drr陣列值)
Next
[訂單未交!G3].Resize(UBound(Brr), 1) = Brr
'↑令"訂單未交"工作表[G3]向下擴展 Brr陣列縱向最大索引號列的範圍儲存格值以Brr陣列帶入
Set Z = Nothing: Erase Brr, Drr, Crr
'↑釋放變數
End Sub

fantersy

回復 5# singo1232001


    謝謝大大的幫忙

fantersy

各位大大越寫越精簡
對於還在學習得我
需要時間去理解一下
謝謝各位的協助

Andy2483

回復 1# fantersy


    以下是複習 以字典記住計算必要資料,再倒出做計算的心得註解,請前輩參考

Option Explicit
Sub TEST()
Dim Brr, Crr, Drr, Z, i&, T$
'↑宣告變數:(Brr, Crr, Drr, Z)是通用型變數,i是長整數,T是字串變數
Crr = Range([axmr450!R1], [axmr450!A65536].End(3))
'↑令Crr變數是二維陣列,以"axmr450"工作表[R1]到A欄最後有內容儲存格值帶入
Drr = Range([庫存!G1], [庫存!A65536].End(3))
'↑令Drr變數是二維陣列,以 "庫存"工作表[G1]到A欄最後有內容儲存格值帶入
Brr = Range([訂單未交!B3], [訂單未交!B65536].End(3))
'↑令Brr變數是二維陣列,以 "訂單未交"工作表[B3]到B欄最後有內容儲存格值帶入
Set Z = CreateObject("Scripting.Dictionary")
'↑令Z這通用型變數是字典
For i = 2 To UBound(Drr)
'↑設順迴圈!i變數從2 到Drr陣列最大索引列號
   T = Trim(Drr(i, 5)) & "|" & Trim(Drr(i, 1))
   '↑令T這字串變數是
   '以"|"符號連接迴圈列5/1攔Drr陣列值去頭尾空白字元的新字串
   Z(T) = Z(T) + Val(Drr(i, 6))
   '↑令以T變數為key,item是累加i迴圈列第6攔Drr陣列值轉化的數值
   '納入Z字典裡
Next
For i = 2 To UBound(Crr)
'↑設順迴圈!i變數從2 到Crr陣列最大索引列號
   T = Trim(Crr(i, 7))
   '↑令T變數是 i迴圈列第7攔Crr陣列值去頭尾空字元的新字串
   Z(T & "|數量") = Z(T & "|數量") + Val(Crr(i, 10))
   '↑令T變數連接 "|數量" 組成的新字串為key,
   'item是累加i迴圈列第10攔Crr陣列值轉化的數值
   '納入Z字典裡
   Z(T & "|總出") = Z(T & "|總出") + Val(Crr(i, 18))
   '↑令T變數連接 "|總出" 組成的新字串為key,
   'item是累加i迴圈列第18攔Crr陣列值轉化的數值
   '納入Z字典裡
Next
For i = 1 To UBound(Brr)
'↑設順迴圈!i變數從1 到Brr陣列最大索引列號
   T = Trim(Brr(i, 1))
   '↑令T變數是 i迴圈列第1攔Brr陣列值去頭尾空字元的新字串
   Brr(i, 1) = Z(T & "|數量") - Z(T & "|總出") - Z("JMZ1" & "|" & T)
   '↑令i迴圈列1欄Brr陣列值是 T關鍵字組合字串查Z字典經所需規則計算後的值
Next
[訂單未交!G3].Resize(UBound(Brr), 1) = Brr
'↑令"訂單未交"工作表[G3]向下擴展Brr陣列縱向最大索引列號列,
'此擴展範圍儲存格值以Brr陣列值帶入
Set Z = Nothing: Erase Brr, Drr, Crr
'↑令釋放變數
End Sub