- 按科目代碼匯總月份數(shù)據(jù)|完整代碼
1,、在工作表“匯總”里,，命令按鈕點擊事件,，調用mySum過程： Private Sub CmdSum_Click() Call mySumEnd Sub 2,、在myModule 里,，mySum過程,，匯總數(shù)據(jù)：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")第二部分：處理數(shù)據(jù)，把科目代碼,、月份分別裝入SortedList,，把借方合計,、貸方合計數(shù)據(jù)裝入字典 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 '//循環(huán)數(shù)組，把科目代碼與名稱加入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 '//遇到下個月份退出循環(huán) 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第三部分：重新定義一個數(shù)組,，在數(shù)組中把數(shù)據(jù)按照匯總表的格式處理完畢 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 第四部分：把數(shù)組數(shù)據(jù)寫入匯總表,，設置數(shù)據(jù)區(qū)域的格式 '//把數(shù)據(jù)寫入工作表，并設置格式 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
|
