帖子: 132
主題: 35
精華: 0
積分: 179
點名: 0
作業系統: Windows
軟體版本: Office 2007
閱讀權限: 20
性別: 男
來自: Taiwan
註冊時間: 2014-12-24
最後登錄: 2024-8-2

1^# 跳轉到 » 正序看帖

字體大小: tT

發表於 2023-10-4 19:53 | 只看該作者

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

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

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

小弟的邏輯真的不好，想了好天都寫不出來
檔案內容有小弟寫到一半的程式語法
真心想學但力不從心，懇請賜教
謝謝!!:)

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

樓主熱帖

Andy2483

　暱稱: 厚臉皮的學生

大學生 Rank: 4

帖子: 1447
主題: 40
精華: 0
積分: 1471
點名: 0
作業系統: Windows 7
軟體版本: Excel 2010 & 2016
閱讀權限: 50
性別: 男
來自: 台灣
註冊時間: 2020-7-15
最後登錄: 2024-12-5

9^#

發表於 2023-10-25 13:09 | 只看該作者

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

用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

fantersy

中學生 Rank: 2

帖子: 132
主題: 35
精華: 0
積分: 179
點名: 0
作業系統: Windows
軟體版本: Office 2007
閱讀權限: 20
性別: 男
來自: Taiwan
註冊時間: 2014-12-24
最後登錄: 2024-8-2

8^#

發表於 2023-10-13 11:21 | 只看該作者

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

TOP

fantersy

中學生 Rank: 2

帖子: 132
主題: 35
精華: 0
積分: 179
點名: 0
作業系統: Windows
軟體版本: Office 2007
閱讀權限: 20
性別: 男
來自: Taiwan
註冊時間: 2014-12-24
最後登錄: 2024-8-2

7^#

發表於 2023-10-13 11:20 | 只看該作者

回復 5# singo1232001

謝謝大大的幫忙

TOP

Andy2483

　暱稱: 厚臉皮的學生

大學生 Rank: 4

帖子: 1447
主題: 40
精華: 0
積分: 1471
點名: 0
作業系統: Windows 7
軟體版本: Excel 2010 & 2016
閱讀權限: 50
性別: 男
來自: 台灣
註冊時間: 2020-7-15
最後登錄: 2024-12-5

6^#

發表於 2023-10-11 11:12 | 只看該作者

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

singo1232001

　暱稱: 熱狗慶

中學生 Rank: 2

帖子: 354
主題: 5
精華: 0
積分: 387
點名: 0
作業系統: windows7
軟體版本: vba,vb,excel2007
閱讀權限: 20
性別: 男
註冊時間: 2017-1-8
最後登錄: 2024-8-2

論壇榮譽勳章論壇贊助勳章

5^#

發表於 2023-10-7 23:27 | 只看該作者

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

singo1232001

　暱稱: 熱狗慶

中學生 Rank: 2

帖子: 354
主題: 5
精華: 0
積分: 387
點名: 0
作業系統: windows7
軟體版本: vba,vb,excel2007
閱讀權限: 20
性別: 男
註冊時間: 2017-1-8
最後登錄: 2024-8-2

論壇榮譽勳章論壇贊助勳章

4^#

發表於 2023-10-6 15:47 | 只看該作者

回復 3# fantersy

我求出來的答案不同

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

fantersy

中學生 Rank: 2

帖子: 132
主題: 35
精華: 0
積分: 179
點名: 0
作業系統: Windows
軟體版本: Office 2007
閱讀權限: 20
性別: 男
來自: Taiwan
註冊時間: 2014-12-24
最後登錄: 2024-8-2

3^#

發表於 2023-10-6 11:58 | 只看該作者

回復 2# Andy2483

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

TOP

Andy2483

　暱稱: 厚臉皮的學生

大學生 Rank: 4

帖子: 1447
主題: 40
精華: 0
積分: 1471
點名: 0
作業系統: Windows 7
軟體版本: Excel 2010 & 2016
閱讀權限: 50
性別: 男
來自: 台灣
註冊時間: 2020-7-15
最後登錄: 2024-12-5

2^#

發表於 2023-10-6 09:05 | 只看該作者

本帖最後由 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