把雜亂無章的資料，整理成每個編號的組合
把 Sheet1 雜亂無章的資料，整理成此表中以每個編號為一組並且小計金額，計算總額；編號是由大至小排列，日期以最早到最近排列，請問VBA如何實現？
謝謝各位高手賜教！
[attach]36305[/attach]
[attach]36306[/attach] 可以用SQL做到就最好了 VBA..與EH同一附件//
[attach]36308[/attach] [b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=121176&ptid=23985]1#[/url] [i]maiko[/i] [/b]
謝謝前輩發表此主題與範例
後學藉此帖學習以VBA執行小計功能,學習方案如下,請前輩參考
執行結果:
[attach]36309[/attach]
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 [b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=121179&ptid=23985]3#[/url] [i]准提部林[/i] [/b]
謝謝前輩
後學藉此帖學習前輩的方案,學習心得註解如下,請前輩再指導
Sub TEST_A1()
Dim Arr, Brr, Crr, i&, j%, N&, T$, D, DS, TD$, S1, S2
[color=SeaGreen]'↑宣告變數[/color]
With Range(Sheet1.[d1], Sheet1.[a65536].End(3)(2))
[color=SeaGreen]'↑匡列儲存格範圍[/color]
Brr = .Value
[color=SeaGreen] '↑令變數成為陣列,以儲存格值帶入陣列[/color]
.Sort key1:=.Item(4), Order1:=xlAscending, key2:=.Item(1), Order2:=xlDescending, Header:=xlYes
[color=SeaGreen] '↑令匡列儲存格範圍做兩層次的有標題列排序[/color]
Arr = .Value
[color=SeaGreen] '↑令另一個變數成為陣列,以排序後的儲存格值帶入陣列[/color]
.Offset(1).ClearContents
[color=SeaGreen] '↑令匡列儲存格範圍[/color]
Crr = .Resize(UBound(Brr) * 3)
[color=SeaGreen] '↑令Crr是匡列標提列向下(3倍Brr陣列縱向列數)的二維陣列[/color]
MsgBox "Crr陣列縱向最大索引號: " & UBound(Crr)
.Value = Brr
[color=SeaGreen] '↑令Sheet1被匡列儲存格恢復原來的儲存格值[/color]
End With
For i = 2 To UBound(Arr) - 1
[color=SeaGreen]'↑設順迴圈[/color]
T = Arr(i, 1): D = Arr(i, 4)
[color=SeaGreen] '↑令變數帶入值[/color]
If T & D <> TD Then TD = T & D: S1 = 0
[color=SeaGreen] '↑如果T變數 連接D變數 組成的新字串 與TD變數不同,
'就令TD變數是 T變數 連接D變數 組成的新字串,令S1變數 歸零[/color]
If D <> DS Then DS = D: S1 = 0: S2 = 0
[color=SeaGreen] '↑如果D變數 與DS變數不相同!就令 DS變數值同 D變數,
'令S1變數歸零,令S2變數也歸零[/color]
N = N + 1
[color=SeaGreen] '↑令N變數累加1[/color]
For j = 1 To 4: Crr(N + 1, j) = Arr(i, j): Next
[color=SeaGreen] '↑設順迴圈將Arr陣列值逐欄帶入指定的Crr陣列位置[/color]
S1 = S1 + Arr(i, 3): S2 = S2 + Arr(i, 3)
[color=SeaGreen] '↑令S1變數累加 同編號的金額
'↑令S2變數累加 同日期的金額[/color]
If Arr(i + 1, 1) & Arr(i + 1, 4) = TD Then GoTo i01
[color=SeaGreen] '↑如果編號連接日期組成的新字串與 TD變數相同!就跳到 i01位置繼續執行[/color]
N = N + 1: Crr(N + 1, 2) = "<SUM>": Crr(N + 1, 3) = S1
[color=SeaGreen] '↑令空出一列帶入"<SUM>"標記與 小計值[/color]
If Arr(i + 1, 4) <> DS Then N = N + 2: Crr(N, 2) = "<TOTLA>": Crr(N, 3) = S2
[color=SeaGreen] '↑如果日期與DS變數不同!就空出 2列,帶入"<TOTLA>"標記與 日期總計值[/color]
i01: Next i
With Sheet2
.UsedRange.ClearContents
[color=SeaGreen] '↑令清除表2 舊資料[/color]
.[a1].Resize(N + 1, 4) = Crr
[color=SeaGreen] '↑令Crr陣列值寫入表2[/color]
End With
End Sub 謝謝各位教導
頁:
[1]