返回列表 上一主題 發帖

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

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

本帖最後由 fantersy 於 2023-10-4 19:58 編輯

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

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

本帖最後由 Andy2483 於 2023-10-6 11:15 編輯

回復 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
看得懂是應該的,懂得應用才像學生,臉皮厚點學會更謹慎積極

TOP

回復 2# Andy2483


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

TOP

回復 3# fantersy


   
未命名.png
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)

TOP

回復 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)

TOP

回復 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
看得懂是應該的,懂得應用才像學生,臉皮厚點學會更謹慎積極

TOP

回復 5# singo1232001


    謝謝大大的幫忙

TOP

        靜思自在 : 【為善競爭】人生要為善競爭,分秒必爭。
返回列表 上一主題