[發問] 把雜亂無章的資料，整理成每個編號的組合

maiko

把 Sheet1 雜亂無章的資料，整理成此表中以每個編號為一組並且小計金額，計算總額；

編號是由大至小排列，日期以最早到最近排列，請問VBA如何實現？

謝謝各位高手賜教！

下載 (117.95 KB)

2023-5-5 15:17

RA.rar (10.06 KB)

下載次數: 5

2023-5-5 15:17

maiko

可以用SQL做到就最好了

准提部林

VBA..與EH同一附件//
Xl0000166.rar (17.44 KB)

下載次數: 13

2023-5-7 10:43

Andy2483

回復 1# maiko


    謝謝前輩發表此主題與範例
後學藉此帖學習以VBA執行小計功能,學習方案如下,請前輩參考

執行結果:

下載 (132.17 KB)

2023-5-8 09:44

Option Explicit
Sub TEST()
Application.ScreenUpdating = False: Sheet1.[A:D].Copy [Sheet2!A1]
With [Sheet2!A1].CurrentRegion
   .Sort KEY1:=.Item(4), Order1:=1, Key2:=.Item(1), Order2:=2, Header:=1, Orientation:=1
   .Subtotal GroupBy:=4, Function:=xlSum, TotalList:=Array(3), SummaryBelowData:=True
End With
With Sheet2.[A1].CurrentRegion
   .Value = .Value
   .Subtotal GroupBy:=2, Function:=xlSum, TotalList:=Array(3), SummaryBelowData:=True
End With
With Sheet2.[A1].CurrentRegion
   .Cells.ClearOutline: .Offset(.EntireRow.Rows.Count - 2).Clear: .EntireColumn.AutoFit
End With
End Sub

Andy2483

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

maiko

謝謝各位教導