字典依條件計算各月金額與數量

shuo1125

各位前輩好!
請問想從資料表中計算各月支付總額及數量輸出於統計表中，
這個若要用字典方式來如何做..?
如附檔，煩請高手幫忙解答，
謝謝大家!!

Andy2483

回復 1# shuo1125


    謝謝前輩發表此主題與範例檔
後學藉此帖練習陣列與字典,學習方案如下,請前輩參考

資料表:

下載 (132.29 KB)

2023-6-7 10:06

統計表執行前:

下載 (67.6 KB)

2023-6-7 09:46

執行結果:

下載 (94 KB)

2023-6-7 09:47

這是不自動(擴增或縮減)年分欄位的方案(用公式應該也能處理)

Option Explicit
Sub TEST()
Dim Brr, V&, Y, Z, i&, j%, T$, xR As Range
Set Y = CreateObject("Scripting.Dictionary")
Brr = Range([資料!D2], [資料!A65536].End(3))
For i = 1 To UBound(Brr)
   T = Brr(i, 1): V = Brr(i, 4)
   Z = Switch(V <= 5000, "5000以下", (V > 5000) * (V <= 10000), "5001~10000", V > 10000, "10000以上")
   Y(T & "|" & Z) = Y(T & "|" & Z) + V: Y(T & "|" & Z & "|Qty") = Y(T & "|" & Z & "|Qty") + 1
Next
'=========================================
[統計!B2:G4,統計!B8:G10].ClearContents
Set xR = [統計!A1:G4]: Brr = xR
For i = 2 To UBound(Brr)
   For j = 2 To UBound(Brr, 2): Brr(i, j) = Y(Brr(1, j) & "|" & Brr(i, 1)): Next
Next
xR = Brr
'=========================================
Set xR = [統計!A7:G10]: Brr = xR
For i = 2 To UBound(Brr)
   For j = 2 To UBound(Brr, 2): Brr(i, j) = Y(Brr(1, j) & "|" & Brr(i, 1) & "|Qty"): Next
Next
xR = Brr
Set Y = Nothing: Set xR = Nothing: Erase Brr
End Sub

hcm19522

B8:G10=COUNTIFS(資料!$A:$A,統計!B$7,資料!$D:$D,"<="&CHOOSE(ROW(A1),5000,10000,10^9))-SUM(B$7:B7)+B$7

shuo1125

回復 3# hcm19522
hcm大真的是把函數發揮的淋漓盡致....謝謝了!
但我比較偏向用VB處理。

shuo1125

回復 2# Andy2483
感謝Andy大總是快速的解答....

Andy2483

回復 5# shuo1125

謝謝前輩回復
後學再檢視並做心得註解如下,請前輩參考

Option Explicit
Sub TEST()
Dim Brr, V&, Y, Z, i&, j%, T$, xR As Range
'↑宣告變數
Set Y = CreateObject("Scripting.Dictionary")
'↑令Y變數是 字典
Brr = Range([資料!D2], [資料!A65536].End(3))
'↑令Brr變數是 二維陣列,以資料表A~D欄儲存格值帶入陣列中
For i = 1 To UBound(Brr)
'↑設順迴圈!將各組合key定義其item值納入Y字典中
   T = Brr(i, 1): V = Brr(i, 4)
   '↑令陣列值以變數盛裝
   Z = Switch(V <= 5000, "5000以下", (V > 5000) * (V <= 10000), "5001~10000", V > 10000, "10000以上")
   '↑令Z變數=Switch(條件1,值1,條件2,值2,條件3,值3)
   Y(T & "|" & Z) = Y(T & "|" & Z) + V: Y(T & "|" & Z & "|Qty") = Y(T & "|" & Z & "|Qty") + 1
   '↑令組合字串當key,item是陣列值累加'↑令組合字串當key,item是類別個數累加
Next
'=========================================
[統計!B2:G4,統計!B8:G10].ClearContents
'↑令統計表舊資料清除
Set xR = [統計!A1:G4]: Brr = xR
'↑令xR變數是 儲存格,令Brr換裝xR(新儲存格值)
For i = 2 To UBound(Brr)
'↑設順迴圈!
   For j = 2 To UBound(Brr, 2): Brr(i, j) = Y(Brr(1, j) & "|" & Brr(i, 1)): Next
   '↑設順迴圈!令迴圈陣列值是(以標題列連接"|",再連接標題欄的組合字串查Y字典得item值)
Next
xR = Brr
'↑令儲存格值是Brr陣列值
'=========================================
Set xR = [統計!A7:G10]: Brr = xR
'↑令xR變數是 儲存格,令Brr換裝xR(新儲存格值)
For i = 2 To UBound(Brr)
'↑設順迴圈!
   For j = 2 To UBound(Brr, 2): Brr(i, j) = Y(Brr(1, j) & "|" & Brr(i, 1) & "|Qty"): Next
   '↑設順迴圈!
   '令迴圈陣列值是(以標題列連接"|",再連接標題欄,最後連接"|Qty"的組合字串查Y字典得item值)
Next
xR = Brr
'↑令儲存格值是Brr陣列值
Set Y = Nothing: Set xR = Nothing: Erase Brr
'↑令釋放變數
End Sub

准提部林

Z = Switch(V > 10000, "10000以上", V > 5000, "5001~10000", V = V, 5000以下")

shuo1125

回復 7# 准提部林
准大好!
想請問若要自動擴充年月及合計...這有辦法處理嗎?
我有曾經看過你寫類似的...但我實在不知道怎調適...
(Xl0000789)您的這份是以客戶來做統計分類與我這問題有點不太一樣，
謝謝你了!!

Andy2483

回復 7# 准提部林


    謝謝前輩指導

Z = Switch(V > 10000, "10000以上", V > 5000, "5001~10000", V = V, 5000以下")
1.10000以上的筆數較5000以下的筆數多
2.大到小判斷會自然產生邏輯區間是Switch()的重要觀念

Andy2483

回復 1# shuo1125


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

執行結果:

下載 (167.89 KB)

2023-6-8 11:49

Option Explicit
Sub TEST_1() '↑
Dim Brr, Crr(1 To 100, 1 To 100), Z, A, B$, i&, R&, C%, Y&, X%, T$, K%, S%, N&, M, Q
Set Z = CreateObject("Scripting.Dictionary"): C = 1: R = 1
A = Array(0, 5000, 10000, 50000, 100000, 500000, 10 ^ 6, 5000000, 10 ^ 7, 10 ^ 10)
K = UBound(A): S = K + 3
For i = 0 To K - 1
   R = R + 1
   Crr(R, 1) = A(i) + 1 & "~" & vbLf & A(i + 1): Crr(R + S, 1) = Crr(R, 1)
   Z(A(i + 1) & "$") = R: Z(A(i + 1) & "N") = R + S
Next
Brr = Range([資料!D2], [資料!A65536].End(3))
Sheets("統計").UsedRange.Clear
With Sheets("統計").[A1:D4].Resize(UBound(Brr))
   .Value = Brr
   .Sort KEY1:=.Item(1), Order1:=1, Header:=2, Orientation:=1: Brr = .Value
   For i = 1 To UBound(Brr)
      T = Brr(i, 1)
      If Z(T & "y") = "" Then
         C = C + 1: Crr(1, C) = T: Z(T & "y") = C: Crr(S + 1, C) = T
      End If
   Next
   .Sort KEY1:=.Item(4), Order1:=1, Header:=2, Orientation:=1
   Brr = .Value: .Clear
End With
Crr(1, 1) = "彙總-NTD": Crr(S + 1, 1) = "彙總-QTY": B = "[Total]"
R = R + 1: Crr(R, 1) = B: Crr(R + S, 1) = B
C = C + 1: Crr(1, C) = B: Crr(S + 1, C) = B
'=========================================
For i = 1 To UBound(Brr)
   Q = Val(Brr(i, 4))
   If Q > M Then N = N + 1: M = A(N)
   X = Z(Brr(i, 1) & "y"): Y = Z(M & "$")
   Crr(Y, X) = Crr(Y, X) + Q: Crr(R, X) = Crr(R, X) + Q
   Crr(Y, C) = Crr(Y, C) + Q: Crr(R, C) = Crr(R, C) + Q
   Crr(Y + S, X) = Crr(Y + S, X) + 1: Crr(R + S, X) = Crr(R + S, X) + 1
   Crr(Y + S, C) = Crr(Y + S, C) + 1: Crr(R + S, C) = Crr(R + S, C) + 1
Next
With [統計!A1].Resize(R + S, C)
   .Columns.ColumnWidth = 14
   Intersect(.Cells, Rows("1:" & K + 2)).Borders.LineStyle = 1
   Intersect(.Cells, Rows(S + 1 & ":" & R + S)).Borders.LineStyle = 1
   Union(.Rows(1), .Rows(K + 2), .Rows(S + 1)).Font.Bold = True
   Union(.Rows(R + S), .Columns(C)).Font.Bold = True
   Range([B2], .Cells(K + 2, C)).NumberFormatLocal = "#,##0_ "
   Range(.Cells(S + 2, 2), .Cells(R + S, C)).NumberFormatLocal = "#,##0_ "
   .Value = Crr
End With
Set Z = Nothing: Erase Brr, Crr, A
End Sub