多工作表某一列求和将值罗列在汇总表中

sulli112

想要将每个工作表中C列的数据求和后，统一按照：表名，求和值一一罗列在新建的汇总表中要怎么写呢，我用SUM函数不太行，实际操作中有50个表左右

opel-wong

循环一下就可以了，

1. Sub 求和()
   
2.     Const sName As String = "求和"
   
3.     Dim sht As Worksheet, arr, m As Long
   
4.     ReDim arr(1 To Sheets.Count, 1 To 2)
   
5.     m = 0
   
6.     For Each sht In Sheets
   
7.         If sht.Name <> sName Then
   
8.             m = m + 1
   
9.             arr(m, 1) = sht.Name
   
10.             arr(m, 2) = Application.WorksheetFunction.Sum(sht.Range("c:c").Value)
    
11.         End If
    
12.     Next
    
13.     If bIsWorksheetExist(sName) = False Then Worksheets.Add(after:=Sheets(Sheets.Count)).Name = sName
    
14.     With Sheets(sName)
    
15.         .Activate
    
16.         .Cells.Clear
    
17.         .Range("A1:B1").Value = Array("工作表表名", "C列求和值")
    
18.         .Range("A2").Resize(m, 2).Value = arr
    
19.     End With
    
20.     MsgBox "ok"
    
21. End Sub
    
22. 
    
23. Public Function bIsWorksheetExist(wksName As String) As Boolean
    
24.     On Error Resume Next
    
25.     bIsWorksheetExist = Sheets(wksName).Name = wksName
    
26. End Function

复制代码

opel-wong

循环一下工作表，就可以了，

笨鸟飞不高

合并.rar (38.73 KB, 下载次数: 34)

2020-9-25 20:15 上传

点击文件名下载附件

sulli112

笨鸟飞不高 发表于 2020-9-25 20:15

Sub AwTest()
    Dim i&, r&, s, arr, brr(1 To 5000, 1 To 2), ws As Worksheet
    Application.DisplayAlerts = False '禁止弹出关对话框
    For Each ws In Sheets
        If ws.Name = "汇总" Then ws.Delete
    Next
    Application.DisplayAlerts = True
    Sheets.Add.Name = "汇总"
    [a1] = "表名": [b1] = "求和值"
    For Each ws In Sheets
        If ws.Name <> "汇总" Then
            s = 0
            arr = ws.[a1].CurrentRegion
            For i = 2 To UBound(arr)
                If Len(arr(i, 3)) Then s = s + arr(i, 3)
            Next
            r = r + 1
            brr(r, 1) = ws.Name: brr(r, 2) = s
        End If
    Next
    If r > 0 Then Sheets("汇总").[a2].Resize(r, 2) = brr
End Sub
想请教一下第二段标红为什么要这么写呢，还有想请教一下，如果我是好几列数据相加求和，那么第一句标红的要怎么修改呢，谢谢

准提部林

Sub TEST_A1()
Dim Sht As Worksheet, xA As Range, xS As Worksheet, SS
Set Sht = Sheets("汇总"): Set xA = Sht.[A1]
Sht.UsedRange.Offset(1, 0).Clear
For Each xS In Sheets
    If xS.Name = Sht.Name Then GoTo X01
    Set xA = xA(2): SS = Application.Sum(xS.[C:C])
    xA.Resize(1, 2) = Array(xS.Name, SS)
X01: Next
End Sub

汇总工作表自行手動建立~~

sulli112

准提部林 发表于 2020-9-26 11:51
Sub TEST_A1()
Dim Sht As Worksheet, xA As Range, xS As Worksheet, SS
Set Sht = Sheets("汇总"): Set ...

Sub TEST_A1()
Dim Sht As Worksheet, xA As Range, xS As Worksheet, SS
Set Sht = Sheets("汇总"): Set xA = Sht.[A1]
Sht.UsedRange.Offset(1, 0).Clear
For Each xS In Sheets
    If xS.Name = Sht.Name Then GoTo X01
    Set xA = xA(2): SS = Application.Sum(xS.[C:D])
    xA.Resize(1, 2) = Array(xS.Name, SS)
X01: Next
End Sub
想问一下，标红那两句，第一句为什么之间要用：呢，第二句xa（2）代表A2单元格的意思吗

准提部林

sulli112 发表于 2020-9-26 15:39
Sub TEST_A1()
Dim Sht As Worksheet, xA As Range, xS As Worksheet, SS
Set Sht = Sheets("汇总"): S ...

":"號..可以將上下兩行程式放在同一行,
因那二行屬同一層次的定義, 所以放在同一行, 一氣呵成~~
set xA = xA(2)...轉到下一工作表時, 自動從A1設定為A2...類推到工作表結束~~

sulli112

准提部林 发表于 2020-9-26 19:57
":"號..可以將上下兩行程式放在同一行,
因那二行屬同一層次的定義, 所以放在同一行, 一氣呵成~~
set xA ...

懂啦，谢谢