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 時間: 2023-10-6 11:58
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
避免過於程序過長精簡
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
