如何快速合并合并报表

htj1278

如何快速合并报表、按线路、按车牌号、笔数、应收等汇总

一指禅62

标记一下。

一指禅62

1. Option Explicit
   
2. Option Base 1
   
3. 
   
4. Sub 一键汇总()
   
5.     Dim Sh As Worksheet, arr, i%
   
6.     Dim a1(10000, 4), m1%, n1%
   
7.     Dim a2(10000, 4), m2%, n2%
   
8.     Dim d1 As Object, d2 As Object
   
9.     Set d1 = CreateObject("scripting.dictionary")
   
10.     Set d2 = CreateObject("scripting.dictionary")
    
11.     For Each Sh In ThisWorkbook.Worksheets
    
12.         If InStr(Sh.Name, "汇总") = 0 Then
    
13.             Debug.Print Sh.Name
    
14.             arr = Sh.Range("A1").CurrentRegion.Value
    
15.             For i = 4 To UBound(arr)
    
16.                 If InStr(arr(i, 1), "合计") = 0 Then
    
17.                     Rem  按线路汇总
    
18.                     If Not d1.Exists(arr(i, 1)) Then
    
19.                         n1 = n1 + 1: m1 = n1
    
20.                         d1(arr(i, 1)) = n1
    
21.                     Else
    
22.                         m1 = d1.Item(arr(i, 1))
    
23.                     End If
    
24.                     a1(m1, 1) = a1(m1, 1) + arr(i, 3) '总笔数
    
25.                     a1(m1, 2) = a1(m1, 2) + arr(i, 4)  '应收总金额
    
26.                     a1(m1, 3) = a1(m1, 3) + arr(i, 5)  '实收总金额
    
27.                     a1(m1, 4) = a1(m1, 4) + arr(i, 6)  '优惠总金额
    
28.                     
    
29.                     Rem  按车号汇总
    
30.                     If Not d2.Exists(arr(i, 2)) Then
    
31.                         n2 = n2 + 1: m2 = n2
    
32.                         d2(arr(i, 2)) = n2
    
33.                     Else
    
34.                         m2 = d2.Item(arr(i, 2))
    
35.                     End If
    
36.                     a2(m2, 1) = a2(m2, 1) + arr(i, 3)  '总笔数
    
37.                     a2(m2, 2) = a2(m2, 2) + arr(i, 4) '应收总金额
    
38.                     a2(m2, 3) = a2(m2, 3) + arr(i, 5) '实收总金额
    
39.                     a2(m2, 4) = a2(m2, 4) + arr(i, 6) '优惠总金额
    
40.                 End If
    
41.             Next
    
42.         End If
    
43.     Next
    
44.     Sheets("线路汇总").Select
    
45.     Range("A3:E1000").ClearContents
    
46.     Range("A3:E1000").Borders.LineStyle = xlNone
    
47.     Range("A3").Resize(d1.Count, 1) = WorksheetFunction.Transpose(d1.keys)
    
48.     Range("B3").Resize(d1.Count, 4) = a1
    
49.     Range("A3").Resize(d1.Count, 5).Borders.LineStyle = xlContinuous
    
50.     Columns("B:B").NumberFormatLocal = "#,##0_);[红色](#,##0)"
    
51.     Columns("C:E").NumberFormatLocal = "#,##0.00_);[红色](#,##0.00)"
    
52.     Cells.Columns.AutoFit
    
53.    
    
54.     Sheets("车牌号汇总").Select
    
55.     Range("A3:E1000").ClearContents
    
56.     Range("A3:E1000").Borders.LineStyle = xlNone
    
57.     Range("A3").Resize(d2.Count, 1) = WorksheetFunction.Transpose(d2.keys)
    
58.     Range("B3").Resize(d2.Count, 4) = a2
    
59.     Range("A3").Resize(d2.Count, 5).Borders.LineStyle = xlContinuous
    
60.     Columns("B:B").NumberFormatLocal = "#,##0_);[红色](#,##0)"
    
61.     Columns("C:E").NumberFormatLocal = "#,##0.00_);[红色](#,##0.00)"
    
62.     Cells.Columns.AutoFit
    
63. End Sub
    

复制代码

一指禅62

公交车载日刷卡营收款汇总.zip (952.27 KB, 下载次数: 29)

2021-3-27 09:50 上传

点击文件名下载附件