有什么办法，可以用代码一次是达到这将“

dyydyydyy

有什么办法，可以用代码一次是达到这将“

moonlit123

=SUM(INDIRECT(A1 &"!E:E"))

这样？

dyydyydyy

不是这样的意思的，就是从前面几个表中，对含有“营业收入”的那一列进行累计，然后生成这“汇总”表。

dyydyydyy

我这例子中，就是将“全行业”、“运输仓储和邮政”、“息传输软件和信息技术”、“房地产”、“赁和商务”，这5个表中的“营业收业”这一列汇总到“汇总”这个表

Jaofuan

1. Sub jaofuan()
   
2.     Dim ar(1 To 5, 1 To 2), br
   
3.     For Each c In Worksheets
   
4.         If c.Name <> "汇总" Then
   
5.             drow = c.Cells(Rows.Count, 1).End(xlUp).Row
   
6.             br = c.Range("e2:e" & drow)
   
7.             p = p + 1
   
8.             ar(p, 1) = c.Name
   
9.             ar(p, 2) = Application.Sum(br)
   
10.         End If
    
11.     Next
    
12.     Sheets("汇总").[a1].Resize(5, 2) = ar
    
13. End Sub

复制代码

dyydyydyy

你好，这程序很强悍，但如果我是不知有几个表要统计的则怎修改一下呢？

moonlit123

1. Sub 汇总()
   
2. Dim arr(), brr(), i, n
   
3. ReDim arr(1 To Sheets.Count, 1 To 2)
   
4. 
   
5. For i = 1 To Sheets.Count
   
6.   brr = Sheets(i).[e1:e65536].Value
   
7.     For n = 1 To UBound(brr)
   
8.       brr(n, 1) = Val(brr(n, 1))
   
9.     Next n
   
10.   arr(i, 1) = Sheets(i).Name
    
11.   arr(i, 2) = Application.Sum(brr)
    
12. Next i
    
13. 
    
14. Sheets.Add(after:=Sheets(Sheets.Count)).Name = "汇总"
    
15. Sheets("汇总").[a1].Resize(UBound(arr), 2) = arr
    
16. End Sub
    

复制代码

dyydyydyy

也就是不一定是5个表，有时是3个，有时是8个，有时是10个，这样随机变的，怎操作呢

xiangbaoan

'附加
Option Explicit
Sub test1()
    Dim Sh As Worksheet, Cel As Range, ar(1 To 1888, 1 To 2), br, i%, k%, n#
    For Each Sh In Worksheets
        If Sh.Name <> "汇总" Then
            k = k + 1
            n = 0
            Set Cel = Sh.Rows(1).Find("营业收入", , , 1)
            If Not Cel Is Nothing Then
                br = Sh.[a1].CurrentRegion.Offset(, Cel.Column - 1).Resize(, 1)
                For i = 2 To UBound(br)
                    n = n + Val(br(i, 1))
                Next
                ar(k, 1) = Sh.Name
                ar(k, 2) = n
            End If
        End If
    Next
    With Sheets("汇总")
        .[A:B].ClearContents
        .[A2].Resize(k, 2) = ar
    End With
End Sub
'Sub test2() '这WPS不中，OFFICE安装不完全也不行
'    Dim Cn As Object, sh As Worksheet, ar(), i%
'    Set Cn = CreateObject("ADODB.Connection")
'    Cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0;Data Source=" & ThisWorkbook.FullName
'    For Each sh In Worksheets
'        If sh.Name <> "汇总" Then
'            i = i + 1
'            ReDim Preserve ar(1 To i)
'            ar(i) = "SELECT '" & sh.Name & "',SUM(营业收入) FROM [" & sh.Name & "$" & sh.[a1].CurrentRegion.Address(0, 0) & "]"
'        End If
'    Next
'    With Sheets("汇总")
'        .[A:B].ClearContents
'        .[A2].CopyFromRecordset Cn.Execute(Join(ar, " UNION ALL "))
'    End With
'    Cn.Close
'    Set Cn = Nothing
'End Sub

dyydyydyy

请问“”moonlit123
，你好，你这程序，如果是“营业收入”改了所在列，则不行的，因为“营业收入”是经常在不同的列的。