shuo1125

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

Andy2483

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

回復 11# shuo1125


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

執行結果:

下載 (138.86 KB)

2023-6-9 10:27

'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_ ")