標題: 字典依條件計算各月金額與數量 [打印本頁]

---

作者: shuo1125    時間: 2023-6-6 22:53     標題: 字典依條件計算各月金額與數量

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

---

作者: Andy2483    時間: 2023-6-7 09:52

本帖最後由 Andy2483 於 2023-6-7 10:07 編輯

回復 1# shuo1125


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

資料表:
[attach]36539[/attach]

統計表執行前:
[attach]36537[/attach]

執行結果:
[attach]36538[/attach]

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

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    時間: 2023-6-7 10:14

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

---

作者: shuo1125    時間: 2023-6-7 10:51

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

---

作者: shuo1125    時間: 2023-6-7 10:54

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

---

作者: Andy2483    時間: 2023-6-7 11:17

回復 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

---

作者: 准提部林    時間: 2023-6-7 16:36

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

---

作者: shuo1125    時間: 2023-6-7 17:00

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

---

作者: Andy2483    時間: 2023-6-8 07:26

回復 7# 准提部林


    謝謝前輩指導

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

---

作者: Andy2483    時間: 2023-6-8 11:50

回復 1# shuo1125


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

執行結果:
[attach]36552[/attach]


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

---

作者: shuo1125    時間: 2023-6-8 12:29

回復 10# Andy2483
Andy前輩真的厲害....還將需求擴充延伸，
況且這思路跟效率真的驚人!!
感激!

---

作者: Andy2483    時間: 2023-6-8 16:42

本帖最後由 Andy2483 於 2023-6-8 16:45 編輯

回復 11# shuo1125


    謝謝前輩發表此主題與後學一起學習,謝謝各位前輩,謝謝論壇
後學學習心得註解如下,請前輩參考,請各位前輩指教


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
'↑令Z變數是 字典,令C與R的起始值是 1
A = Array(0, 5000, 10000, 50000, 100000, 500000, 10 ^ 6, 5000000, 10 ^ 7, 10 ^ 10)
'↑令A變數是 一維陣列,佈入想要的金額級距
K = UBound(A): S = K + 3
'↑令K變數是A陣列最大索引號,(PS:A陣列的最小索引號是 0)
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
'↑設順迴圈將標題欄寫入Crr陣列中,並令Z字典記住級距所在的Crr陣列列號
Brr = Range([資料!D2], [資料!A65536].End(3))
'↑令Brr變數是 二維陣列,以資料表A~D欄儲存格值帶入陣列中
Sheets("統計").UsedRange.Clear
'↑令統計表有使用的儲存格清除
With Sheets("統計").[A1:D4].Resize(UBound(Brr))
   .Value = Brr
   .Sort KEY1:=.Item(1), Order1:=1, Header:=2, Orientation:=1: Brr = .Value
   '↑令Brr陣列值先寫入在統計表中先做以第1欄為基準的順排序
   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
   '↑設順迴圈!令標題列寫入Crr陣列中,並令Z字典記住年分所在的欄號
   .Sort KEY1:=.Item(4), Order1:=1, Header:=2, Orientation:=1
   '↑令該範圍儲存格做以第4欄為基準的順排序
   Brr = .Value: .Clear
   '↑令Brr陣列盛裝陣列值,令該範圍儲存格清除
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
'↑令主標題與總和標題寫入Crr陣列中
'================================================
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
'↑設順迴圈將Brr陣列的金額從小到大相加在Crr陣列中
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
'↑處理統計表必要儲存格格式,最後填入Crr陣列值
Set Z = Nothing: Erase Brr, Crr, A
'↑釋放變數
End Sub

---

作者: Andy2483    時間: 2023-6-9 10:28

回復 11# shuo1125


    今天研究標題欄使用千分位逗號的方法,請前輩參考

執行結果:
[attach]36562[/attach]


'Crr(R, 1) = A(i) + 1 & "~" & vbLf & A(i + 1)
Crr(R, 1) = Application.Text(A(i) + 1, "#,##0_ ") & "~" & vbLf & Application.Text(A(i + 1), "#,##0_ ")

---

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