麻辣家族討論版版 - Powered by Discuz! Board

標題: [發問] 跨2工作表查詢比對後呈述成1工作表資料 [打印本頁]

作者: BV7BW 時間: 2022-8-19 14:05 標題: 跨2工作表查詢比對後呈述成1工作表資料

各位先進老師大家好

請教各位先進老師
問題需求
跨2工作表查詢比對後呈述成1工作表資料
以日期K5.K6(111/08/01至111/08/09止)
至(訂貨明細表)中比對.同項目則須加成總和
呈列A2:D2各項資料
E2(庫存)則須至(項目編號)庫存如O4:O103
至KS4:KS103中比對資料
或至(項目編號)NN2至NN2639中比對資料
呈現出E2(庫存)資料
例以下是查詢比對後結果

作者: samwang 時間: 2022-8-22 11:57

各位先進老師大家好

請教各位先進老師
問題需求
跨2工作表查詢比對後呈述成1工作表資料
以日期K5. ...
BV7BW 發表於 2022-8-19 14:05

請測試看看，謝謝
Sub 日期總量查詢()
Dim Arr, xD, T$, Ds As Date, De As Date, i&, j%, n&
Set xD = CreateObject("Scripting.Dictionary")
Ds = [K5]: De = [K6]
Arr = Sheets("訂貨明細表").[a1].CurrentRegion
ReDim Crr(1 To UBound(Arr), 1 To 5)
For i = 2 To UBound(Arr)
If Arr(i, 12) >= Ds And Arr(i, 12) <= De Then
      T = Arr(i, 4)
      If xD.Exists(T) Then
         Crr(xD(T), 3) = Crr(xD(T), 3) + Arr(i, 5)
      Else
         n = n + 1: xD(T) = n
         For j = 3 To 6: Crr(n, j - 2) = Arr(i, j): Next
      End If
End If
Next
With Sheets("項目編號")
Arr = .Range("F3").CurrentRegion
For j = 6 To UBound(Arr, 2) Step 10
      For i = 4 To UBound(Arr)
         T = Arr(i, j): If T = "" Then GoTo 91
         xD(T) = Arr(i, j + 9)
91:    Next
Next
End With
For i = 1 To n: Crr(i, 5) = xD(Crr(i, 1) & ""): Next
If n > 0 Then
Range("a2:e1000") = ""
Range("a2").Resize(n, 5) = Crr
End If
End Sub

作者: BV7BW 時間: 2022-8-22 14:04

回復 2# samwang
samwang 老師你好

經測試已非常正確符合需求.庫存資料也正確登錄

謝謝 samwang 老師指導

庫存部分是否在上提文中修改
Sub 單項目查詢()
'程式資料來源至sanwanq2022-7-29 指導
Dim Arr, xD, T$, Ds As Date, De As Date
Dim Brr(1 To 1, 1 To 4), Crr(), n%, i&, j%
Range("R2:V12").Select
Selection.ClearContents
Range("A2:E1500").Select
Selection.ClearContents
Range("Q2:V300").Select
Selection.ClearContents
'Range("O2:O100").Select
'Selection.ClearContents
Range("K7").Select
Set xD = CreateObject("Scripting.Dictionary")
Ds = [K5]: De = [K6]: T = [K9]
Arr = Sheets("訂貨明細表").[a1].CurrentRegion
ReDim Crr(1 To UBound(Arr), 1 To 5)
For i = 2 To UBound(Arr)
If Arr(i, 4) <> T Then GoTo 99
If Arr(i, 12) >= Ds And Arr(i, 12) <= De Then
      If n = 0 Then
         n = n + 1: xD(Arr(i, 1) & "") = n
         For j = 1 To 4: Brr(1, j) = Arr(i, j + 2): Next
         Crr(n, 1) = Arr(i, 1): Crr(n, 2) = Arr(i, 3)
         Crr(n, 3) = Arr(i, 4): Crr(n, 4) = Arr(i, 5)
         Crr(n, 5) = Arr(i, 6)
      Else
         If xD.Exists(Arr(i, 1) & "") Then
            m = xD(Arr(i, 1) & "")
            Crr(m, 4) = Arr(i, 5) + Crr(m, 4)
         Else
            n = n + 1: xD(Arr(i, 1) & "") = n
            Crr(n, 1) = Arr(i, 1): Crr(n, 2) = Arr(i, 3)
            Crr(n, 3) = Arr(i, 4): Crr(n, 4) = Arr(i, 5)
            Crr(n, 5) = Arr(i, 6)
         End If
         Brr(1, 3) = Brr(1, 3) + Arr(i, 5)
      End If
End If
99: Next
If n > 0 Then
Range("a2:c2") = ""
Range("a2").Resize(1, 4) = Brr
Range("r2:v8") = ""
Range("r2").Resize(n, 5) = Crr
End If
With ActiveSheet
Beep
End With
End Sub

作者: samwang 時間: 2022-8-22 14:15

回復 samwang
samwang 老師你好

經測試已非常正確符合需求.庫存資料也正確登錄

謝謝 samwang 老 ...
BV7BW 發表於 2022-8-22 14:04

庫存部分是否在上提文中修改 >> 請問這是什麼意思
另外，為何你修改3樓程式碼和2樓不一樣，需求為何? 請確認，謝謝

作者: BV7BW 時間: 2022-8-23 03:24

本帖最後由 BV7BW 於 2022-8-23 03:28 編輯

回復 4# samwang
samwang 老師你好

本提問中以完全正確運作正常

抱歉說明問題表達文辭不好

我是以上次提問中(單項目查詢)sanwanq老師2022-7-29指導中(正常運作中)
跟這次提問是有所相關(庫存)問題是相同
是想這次題問中庫存部分是否也能套入到(單項目查詢)中(庫存)問題

Sub 單項目查詢()sanwanq老師2022-7-29指導中(正常運作)之結果
項編項目名稱數量          單位       庫存
A101    你1          12          台斤

Sub 日期總量查詢()sanwanq老師2022-08-19 指導中(正常運作中)之結果
項編項目名稱數量          單位          庫存
A101    你1          12          台斤             1
A102    我1             2          台斤             1
A103    他1             2          公斤             1
....
....

歡迎光臨麻辣家族討論版版 (http://forum.twbts.com/)