【VBA】【EXCEL】分类汇总

news2026/4/6 21:30:01

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

本文来自互联网用户投稿，该文观点仅代表作者本人，不代表本站立场。本站仅提供信息存储空间服务，不拥有所有权，不承担相关法律责任。如若转载，请注明出处：http://www.coloradmin.cn/o/2490381.html

如若内容造成侵权/违法违规/事实不符，请联系多彩编程网进行投诉反馈，一经查实，立即删除！