- 帖子
- 976
- 主題
- 7
- 精華
- 0
- 積分
- 1018
- 點名
- 0
- 作業系統
- Win10
- 軟體版本
- Office 2016
- 閱讀權限
- 50
- 性別
- 男
- 註冊時間
- 2013-4-19
- 最後登錄
- 2026-5-26
|
各位先進 老師 大家好
請教各位先進 老師
問題需求
跨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 |
|
發表於 2022-8-22 11:57
| 