- 帖子
- 1425
- 主題
- 40
- 精華
- 0
- 積分
- 1449
- 點名
- 0
- 作業系統
- Windows 7
- 軟體版本
- Excel 2010 & 2016
- 閱讀權限
- 50
- 性別
- 男
- 來自
- 台灣
- 註冊時間
- 2020-7-15
- 最後登錄
- 2024-4-16
|
回復 3# 准提部林
謝謝前輩
後學藉此帖學習前輩的方案,學習心得註解如下,請前輩再指導
Sub TEST_A1()
Dim Arr, Brr, Crr, i&, j%, N&, T$, D, DS, TD$, S1, S2
'↑宣告變數
With Range(Sheet1.[d1], Sheet1.[a65536].End(3)(2))
'↑匡列儲存格範圍
Brr = .Value
'↑令變數成為陣列,以儲存格值帶入陣列
.Sort key1:=.Item(4), Order1:=xlAscending, key2:=.Item(1), Order2:=xlDescending, Header:=xlYes
'↑令匡列儲存格範圍做兩層次的有標題列排序
Arr = .Value
'↑令另一個變數成為陣列,以排序後的儲存格值帶入陣列
.Offset(1).ClearContents
'↑令匡列儲存格範圍
Crr = .Resize(UBound(Brr) * 3)
'↑令Crr是匡列標提列向下(3倍Brr陣列縱向列數)的二維陣列
MsgBox "Crr陣列縱向最大索引號: " & UBound(Crr)
.Value = Brr
'↑令Sheet1被匡列儲存格恢復原來的儲存格值
End With
For i = 2 To UBound(Arr) - 1
'↑設順迴圈
T = Arr(i, 1): D = Arr(i, 4)
'↑令變數帶入值
If T & D <> TD Then TD = T & D: S1 = 0
'↑如果T變數 連接D變數 組成的新字串 與TD變數不同,
'就令TD變數是 T變數 連接D變數 組成的新字串,令S1變數 歸零
If D <> DS Then DS = D: S1 = 0: S2 = 0
'↑如果D變數 與DS變數不相同!就令 DS變數值同 D變數,
'令S1變數歸零,令S2變數也歸零
N = N + 1
'↑令N變數累加1
For j = 1 To 4: Crr(N + 1, j) = Arr(i, j): Next
'↑設順迴圈將Arr陣列值逐欄帶入指定的Crr陣列位置
S1 = S1 + Arr(i, 3): S2 = S2 + Arr(i, 3)
'↑令S1變數累加 同編號的金額
'↑令S2變數累加 同日期的金額
If Arr(i + 1, 1) & Arr(i + 1, 4) = TD Then GoTo i01
'↑如果編號連接日期組成的新字串與 TD變數相同!就跳到 i01位置繼續執行
N = N + 1: Crr(N + 1, 2) = "<SUM>": Crr(N + 1, 3) = S1
'↑令空出一列帶入"<SUM>"標記與 小計值
If Arr(i + 1, 4) <> DS Then N = N + 2: Crr(N, 2) = "<TOTLA>": Crr(N, 3) = S2
'↑如果日期與DS變數不同!就空出 2列,帶入"<TOTLA>"標記與 日期總計值
i01: Next i
With Sheet2
.UsedRange.ClearContents
'↑令清除表2 舊資料
.[a1].Resize(N + 1, 4) = Crr
'↑令Crr陣列值寫入表2
End With
End Sub |
|
發表於 2023-5-8 09:45
| 
