【VBA】【EXCEL】分类汇总

option explicit option base 1 Sub 分类汇总() Dim ws0 As Worksheet, ws1 As Worksheet Dim arr0 As Variant, arr1 As Variant Dim lastRow As Long, i As Long, m As Long, cnt As Long Dim acct As String, opp As String, key As String, pts() As String Dim amt As Double, tmp As Variant Dim dict As Object: Set dict CreateObject(Scripting.Dictionary) Set ws0 Sheets(交易数据) Set ws1 Sheets(汇总结果) lastRow ws0.Cells(ws0.Rows.Count, 1).End(xlUp).Row 一次性读入数组 arr0 ws0.Range(A1:D lastRow).Value For i 2 To lastRow acct arr0(i, 1) opp arr0(i, 2) amt arr0(i, 3) key acct | opp If Not dict.Exists(key) Then dict(key) Array(0, 0, 0, 0, 0, 0, 0, ) End If tmp dict(key) tmp(0) tmp(0) 1 If amt 0 Then tmp(1) tmp(1) 1 tmp(4) tmp(4) amt Else tmp(2) tmp(2) 1 tmp(5) tmp(5) amt End If tmp(3) tmp(3) amt If amt Mod 100 0 Then tmp(6) tmp(6) 1 If tmp(7) Or arr0(i, 4) tmp(7) Then tmp(7) arr0(i, 4) End If dict(key) tmp Next i 输出 ws1.Cells.Clear cnt dict.Count ReDim arr1(1 To cnt, 1 To 10) m 1 For Each key In dict.Keys pts Split(key, |) tmp dict(key) arr1(m, 1) pts(0) arr1(m, 2) pts(1) arr1(m, 3) tmp(0) arr1(m, 4) tmp(1) arr1(m, 5) tmp(2) arr1(m, 6) tmp(3) arr1(m, 7) tmp(4) arr1(m, 8) tmp(5) arr1(m, 9) tmp(6) arr1(m, 10) tmp(7) m m 1 Next ws1.Range(A1:J1) Array(账户名, 对手名, 交易总次数, 转出总次数, _ 转入总次数, 累计金额, 转出总金额, 转入总金额, _ 整百金额次数, 最后一次转账时间) If cnt 0 Then ws1.Range(A2:J 1 cnt) arr1 ws1.Columns.AutoFit MsgBox 汇总完成 End Sub