匯整資料

fangsc

請教
sheet2做了一份樞紐篩選,再將篩選後的資料依產品名稱+姓名的累加購買數量放入sheet4
不知為何跑出來的購買數量皆為0
請教如何修改以下程式

i = 1
Do
    If sheet4.Cells(i + 1, "a") & sheet4.Cells(i + 1, "b").Text = sheet2.Cells(4, "n").Text Then
    sheet4.Cells(i + 1, "d") = sheet2.Cells(4, "o")
    ElseIf sheet4.Cells(i + 1, "a") & sheet4.Cells(i + 1, "b").Text <> sheet2.Cells(4, "m") Then
    sheet4.Cells(i + 1, "d") = 0
    End If

i = i + 1
Loop Until Cells(i, "a") = ""
End sub

jcchiang

回復 1# fangsc

試試看!
將"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

回復 2# jcchiang

感謝您的解題. 超出我可以理解程度的寫法.
1. 可以求一個比較初階程度的寫法嗎？
2. 另外補充 : 結果數字要 除10

jcchiang

回復 3# fangsc


這段加個除10就可以
    If a = arr(x, 1) & arr(x, 2) & "-1" Then arr(x, 4) = d(a) / 10: GoTo Line1
至於比較初階程度不了解是如何

fangsc

回復 4# jcchiang
感謝您.

准提部林

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

回復 6# 准提部林

感謝版主指導.

Andy2483

謝謝論壇,謝謝各位前輩
後學藉此帖練習陣列與字典,學習方案如下,請各位前輩指教

資料表:

下載 (300.04 KB)

2023-6-6 16:19

結果表執行前:

下載 (126.32 KB)

2023-6-6 16:16

執行結果:

下載 (132.03 KB)

2023-6-6 16:16

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