[已解决]用VBA在一个工作簿中汇总相同格式的工作表

xujie_nust

我想在最后一张合计表中汇总各地区产品的数量和金额。请各位大神帮忙啊！

最佳答案

月排行榜 / 总排行榜

lisachen

2015-4-5 23:49

Sub tt12()
    Dim sh As Worksheet
    Dim rg As Range
    Dim x, y As Integer
    Set rg = Application.InputBox(prompt:="请选择数据汇总区域", Type:=8)
    rg.ClearContents
    For Each sh In Sheets
        With Sheets("合计_表")
            If sh.Name <> "合计_表" Then
                For x = rg.Row To rg.Row + rg.Rows.Count - 1
                    For y = rg.Column To rg.Column + rg.Columns.Count - 1
                        .Cells(x, y) = sh.Cells(x, y) + .Cells(x, y)
                    Next
                Next
            End If
        End With
    Next
End Sub

跳转到最佳答案楼层

橘子红

1. Sub x()
   
2. Dim sh As Worksheet, x%, d, ar, br(1 To 65500, 1 To 3), k%, r%
   
3. Set d = CreateObject("scripting.dictionary")
   
4. For Each sh In Sheets
   
5.     If sh.Name <> "合计数" Then
   
6.       ar = sh.Range("a1").CurrentRegion
   
7.         For x = 2 To UBound(ar)
   
8.           If d(ar(x, 1)) = "" Then
   
9.                 k = k + 1: d(ar(x, 1)) = k
   
10.                 br(k, 1) = ar(x, 1)
    
11.                 br(k, 2) = ar(x, 2)
    
12.                 br(k, 3) = ar(x, 3)
    
13.             Else
    
14.                 r = d(ar(x, 1))
    
15.                 br(r, 2) = br(r, 2) + ar(x, 2)
    
16.                 br(r, 3) = br(r, 3) + ar(x, 3)
    
17.           End If
    
18.         Next
    
19.     End If
    
20. Next
    
21. Range("a2:c65500").ClearContents
    
22. Range("a2").Resize(k, 3) = br
    
23. MsgBox "汇总完毕"
    
24. End Sub
    

复制代码

xujie_nust

橘子红 发表于 2015-4-5 19:48

非常感谢，能否不用数组和字典。目前水平我还木有达到啊。

lisachen

xujie_nust 发表于 2015-4-5 19:54
非常感谢，能否不用数组和字典。目前水平我还木有达到啊。

2楼的考虑周全
如果位置固定，又不用字典数组，试试这个

1. Sub test()
   
2.     Dim sh As Worksheet
   
3.     Dim x As Integer
   
4.     Range("a2:c65500").ClearContents
   
5.     For Each sh In Sheets
   
6.     With Sheets("合计数")
   
7.         If sh.Name <> "合计数" Then
   
8.             For x = 2 To 22
   
9.                     .Cells(x, 2) = sh.Cells(x, 2) + .Cells(x, 2)
   
10.                     .Cells(x, 3) = sh.Cells(x, 3) + .Cells(x, 3)
    
11.                 Next x
    
12.             End If
    
13.             End With
    
14.         Next
    
15.         MsgBox "汇总完毕"
    
16.     End Sub

复制代码

xujie_nust

lisachen 发表于 2015-4-5 20:48
2楼的考虑周全
如果位置固定，又不用字典数组，试试这个

非常感谢。您的回复给我很大启发。按照你的思路我写了一段代码，能够动态识别汇总区域，但不知道为什么汇总表会有报错，结果也不对。请不吝赐教。感谢感谢！！！

lisachen

xujie_nust 发表于 2015-4-5 23:13
非常感谢。您的回复给我很大启发。按照你的思路我写了一段代码，能够动态识别汇总区域，但不知道为什么汇 ...

汇总表会有报错是因为你F表29行不是空单元格而是含有空格不能用于相加
结果也不是因为没有先清空结果单元格
合计报表.rar (42.79 KB, 下载次数: 23)

2015-4-5 23:47 上传

点击文件名下载附件

lisachen

Sub tt12()
    Dim sh As Worksheet
    Dim rg As Range
    Dim x, y As Integer
    Set rg = Application.InputBox(prompt:="请选择数据汇总区域", Type:=8)
    rg.ClearContents
    For Each sh In Sheets
        With Sheets("合计_表")
            If sh.Name <> "合计_表" Then
                For x = rg.Row To rg.Row + rg.Rows.Count - 1
                    For y = rg.Column To rg.Column + rg.Columns.Count - 1
                        .Cells(x, y) = sh.Cells(x, y) + .Cells(x, y)
                    Next
                Next
            End If
        End With
    Next
End Sub

xujie_nust

lisachen 发表于 2015-4-5 23:49
Sub tt12()
    Dim sh As Worksheet
    Dim rg As Range

感谢感谢，果然是高手啊！追问一下，怎么用vba判断一个空单元格是否含有空格呢？

lisachen

xujie_nust 发表于 2015-4-6 13:12
感谢感谢，果然是高手啊！追问一下，怎么用vba判断一个空单元格是否含有空格呢？

用 vba.IsEmpty可以判断

xujie_nust

lisachen 发表于 2015-4-6 14:14
用 vba.IsEmpty可以判断

好的 感谢大神。