- 帖子
- 1446
- 主題
- 40
- 精華
- 0
- 積分
- 1470
- 點名
- 0
- 作業系統
- Windows 7
- 軟體版本
- Excel 2010 & 2016
- 閱讀權限
- 50
- 性別
- 男
- 來自
- 台灣
- 註冊時間
- 2020-7-15
- 最後登錄
- 2024-10-21
|
12#
發表於 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 |
|
