|
1、在工作表“汇总”里，命令按钮点击事件，调用mySum过程： Private Sub CmdSum_Click() Call mySumEnd Sub 2、在myModule 里，mySum过程，汇总数据：Sub mySum() Dim ws As Worksheet, lastRow As Long, lastCol As Long Dim lstRow As Object, lstCol As Object, sKey As String, sItem As String Dim dic As Object, dKey As String, rng As Range, cell As Range Dim arr(), temp(), str() As String Const CODELENGTH = 20 Set lstRow = CreateObject("System.Collections.SortedList") Set lstCol = CreateObject("System.Collections.SortedList") Set dic = CreateObject("Scripting.Dictionary")第二部分：处理数据，把科目代码、月份分别装入SortedList，把借方合计、贷方合计数据装入字典 For Each ws In ThisWorkbook.Sheets If ws.Name <> "汇总" Then With ws lastRow = .UsedRange.Rows.Count lastCol = .UsedRange.Columns.Count arr = .Range(.Cells(1, 1), .Cells(lastRow, lastCol)) End With '//循环数组，把科目代码与名称加入lst，把借方合计、贷方合计加入字典 For i = 3 To lastRow sKey = arr(i, 2) '//科目代码 If sKey <> "" Then sItem = arr(i, 1) & "|" & sKey & "|" & arr(i, 3) '//序号|代码|名称 '//科目代码补齐20位，确保排序正常 sKey = sKey & String(CODELENGTH - Len(sKey), "0") If Not lstRow.contains(sKey) Then lstRow.Add sKey, sItem End If If Not dic.exists(sKey) Then dic.Add sKey, CreateObject("Scripting.Dictionary") End If For j = 4 To lastCol If arr(1, j) <> "" Then dKey = arr(1, j) '//年月份 dKey = Format(dKey, "yyyy年mm月") If Not lstCol.contains(dKey) Then lstCol.Add dKey, 1 End If If Not dic(sKey).exists(dKey) Then dic(sKey).Add dKey, Array(0, 0) ReDim temp(1) Else temp = dic(sKey)(dKey) End If For m = j To lastCol '//遇到下个月份退出循环 If arr(1, m) <> "" And Format(arr(1, m), "yyyy年mm月") <> dKey Then Exit For If InStr(arr(2, m), "借方合计") > 0 Then temp(0) = temp(0) + arr(i, m) End If If InStr(arr(2, m), "贷方合计") > 0 Then temp(1) = temp(1) + arr(i, m) End If Next dic(sKey)(dKey) = temp End If Next End If Next End If Next第三部分：重新定义一个数组，在数组中把数据按照汇总表的格式处理完毕 lastRow = lstRow.Count + 2 lastCol = lstCol.Count * 2 + 3 ReDim arr(1 To lastRow, 1 To lastCol) arr(2, 1) = "序号" arr(2, 2) = "科目代码" arr(2, 3) = "科目名称" '//填写表头 For i = 0 To lstCol.Count - 1 arr(1, i * 2 + 4) = lstCol.getkey(i) arr(2, i * 2 + 4) = "借方合计" arr(2, i * 2 + 5) = "贷方合计" Next '//填写表列 For i = 0 To lstRow.Count - 1 arr(i + 3, 2) = lstRow.getkey(i) Next For i = 3 To lastRow sKey = arr(i, 2) For j = 4 To lastCol Step 2 dKey = arr(1, j) If dic(sKey).exists(dKey) Then temp = dic(sKey)(dKey) arr(i, j) = temp(0) arr(i, j + 1) = temp(1) End If Next str = Split(lstRow.Item(sKey), "|") arr(i, 1) = str(0) arr(i, 2) = str(1) arr(i, 3) = str(2) Next 第四部分：把数组数据写入汇总表，设置数据区域的格式 '//把数据写入工作表，并设置格式 Set ws = ThisWorkbook.Sheets("汇总") With ws .Cells.Clear Set rng = .Cells(1, 1).Resize(lastRow, lastCol) With rng .Font.Size = 10 .Borders.LineStyle = 1 .VerticalAlignment = xlCenter .Columns(2).NumberFormat = "@" .Value2 = arr For i = 4 To lastCol Step 2 Set cell = .Cells(1, i).Resize(1, 2) With cell .Merge .HorizontalAlignment = xlCenter .Font.Size = 12 .Font.Bold = True End With Next Set cell = .Range(.Cells(3, 4), .Cells(lastRow, lastCol)) With cell .Font.Name = "Times New Roman" .NumberFormat = "_ * #,##0.00_ ;_ * -#,##0.00_ ;_ * ""-""??_ ;_ @_ " End With End With End WithEnd Sub
|
