試試看!
將"N90122購貨明細貼上"內符合"菸架"內名單&產品代號"1"開頭的數量做統計
Sub ex()
Dim d As Object
Dim arr As Object
Dim x%, AA$
Set d = CreateObject("Scripting.Dictionary")
Set arr = Sheets("N90122購貨明細貼上").[a1].CurrentRegion
For x = 2 To arr.Rows.Count
AA = arr(x, 3) & "-" & Left(arr(x, 1), 1)
If Not d.exists(AA) Then
d.Add AA, arr(x, 6)
Else
d(AA) = d(AA) + arr(x, 6)
End If
Next
Set arr = Sheets("菸架").[a1].CurrentRegion
For x = 2 To arr.Rows.Count
For Each a In d
If a = arr(x, 1) & arr(x, 2) & "-1" Then arr(x, 4) = d(a): GoTo Line1
Next
arr(x, 4) = 0
Line1:
Next
End Sub作者: fangsc 時間: 2020-10-21 14:33
Sub TEST_A1()
Dim Arr, xD, i&
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range([N90122購貨明細貼上!J1], [N90122購貨明細貼上!A65536].End(xlUp))
For i = 2 To UBound(Arr)
If Left(Arr(i, 1), 1) <> "1" Then GoTo i01
xD(Arr(i, 3)) = xD(Arr(i, 3)) + Val(Arr(i, 6)) / 10
i01: Next i
Arr = Range([菸架!B2], [菸架!A65536].End(xlUp))
For i = 1 To UBound(Arr)
Arr(i, 1) = xD(Arr(i, 1) & Arr(i, 2))
Next i
[菸架!D2].Resize(UBound(Arr), 1) = Arr
End Sub作者: fangsc 時間: 2020-10-23 16:05
Option Explicit
Sub TEST()
Dim Brr, Crr, Y, T$, T1$, V&, i&, Sh1 As Worksheet, Sh2 As Worksheet
'↑宣告變數
Set Sh1 = Sheets("N90122購貨明細貼上"): Set Sh2 = Sheets("菸架")
'↑令變數裝入物件(工作表)
Set Y = CreateObject("Scripting.Dictionary")
'↑Y變數是 字典
Brr = Range(Sh1.[J1], Sh1.Cells(Rows.Count, 1).End(3))
'↑令Brr變數是 二維陣列,以A~J儲存格值帶入陣列中
For i = 2 To UBound(Brr)
'↑設順迴圈
T1 = Brr(i, 1): T = Brr(i, 3): V = Brr(i, 6)
'↑令T1變數是 第1欄陣列值(字串),令T變數是 第3欄陣列值(字串),
'令V變數是 第6欄陣列值(數值)
If InStr(T1, "1") = 1 Then Y(T) = Y(T) + V / 10
'↑如果T1變數第1個字是 1?
'是就令在Y字典裡的T變數key其item累加(V變數除10)的數值
Next i
Brr = Range(Sh2.[B2], Sh2.Cells(Rows.Count, 1).End(3))
'↑令Brr變數是 二維陣列,換以A~B儲存格值帶入陣列中
ReDim Crr(1 To UBound(Brr), 1 To 1)
'↑令Crr變數是 二維空陣列,縱向範圍同Brr陣列,橫向1~1
For i = 1 To UBound(Brr)
'↑設順迴圈
Crr(i, 1) = Val(Y(Brr(i, 1) & Brr(i, 2)))
'↑令Crr陣列值是 第1欄Brr陣列值連接第2欄Brr陣列組成的新字串,查
'查Y字典得到的item值再轉化為數值的值(補0)
Next i
Sh2.[E2].Resize(UBound(Crr)) = Crr
'↑令結果表從[E2]開始範圍儲存格以Crr陣列值寫入
Set Y = Nothing: Erase Brr, Crr
'↑令釋放變數
End Sub
