【问题标题】:VBA: Sum same columns from multiple sheets in another sheet (Overview)VBA:在另一个工作表中对多个工作表中的相同列求和(概述)
【发布时间】:2021-02-06 10:55:48
【问题描述】:

我是 VBA 新手,想快速学习 :)

我有 6 张 Excel 工作表(第 1-6 个月),数据相同(显示为表格)但行数不同。

  1. 我想创建一个表,将月份 (1-6) 作为行,将数量和储备作为列

  1. 另外,有没有一种方法可以让我编写一个代码,在储备方面为我提供前 3 个客户组(F 列),同时给出相应的数量(E 列)——比如 sumif(),但在 vba 中?

我已经研究了好几天,但没有发现太多...我很高兴能得到任何帮助!非常感谢:)

【问题讨论】:

    标签: excel vba sum sumifs


    【解决方案1】:

    这就是您使用 adodb 对象的方式。只需添加 3 张并运行它。

    数据表作为获取top3的临时表。

    Sub exeSQL(Ws As Worksheet, strSQL As String)
    
        Dim Rs As Object  'ADODB.Recordset
        Dim strConn As String
        Dim i As Integer
    
        strConn = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
            "Data Source=" & ThisWorkbook.FullName & ";" & _
                "Extended Properties=Excel 12.0;"
        
        Set Rs = CreateObject("ADODB.Recordset") 'New ADODB.Recordset
        
        Rs.Open strSQL, strConn
        
        If Not Rs.EOF Then
             With Ws
                .Range("a2").CurrentRegion.ClearContents
                For i = 0 To Rs.Fields.Count - 1
                   .Cells(1, i + 1).Value = Rs.Fields(i).Name
                Next
                .Range("a2").CopyFromRecordset Rs
                .Columns.AutoFit
            End With
        End If
        Rs.Close
        Set Rs = Nothing
    End Sub
    Sub Main()
        Call sumVolume
        Call sumTop3
    End Sub
    Sub sumVolume()
        Dim Ws As Worksheet
        Dim strSQL As String, strU As String
        Dim sName(1 To 6) As Variant
        Dim i As Integer
        
        Set Ws = Sheets("Resultsum")
    
        For i = 1 To 6
            sName(i) = Sheets(i).Name
        Next i
        For i = 1 To 5
            strU = strU & "select '" & sName(i) & "' as sday, [Volume], [Reserves] from [" & sName(i) & "$] union all "
        Next i
            strU = strU & "select '" & sName(6) & "' as sday, [Volume], [Reserves] from [" & sName(6) & "$] "
            
        strSQL = "SELECT sday, sum([Volume]) as [sum of volume], sum([Reserves]) as [sum of Reserves ] "
        strSQL = strSQL & " FROM (" & strU & " )"
        strSQL = strSQL & "WHERE not isnull([Volume]) "
        strSQL = strSQL & "GROUP BY sday "
            
        exeSQL Ws, strSQL
        
        
    End Sub
    Sub sumTop3()
        Dim Ws As Worksheet
        Dim strSQL As String, strU As String
        Dim i As Integer
        
        Call sumData
        
        Set Ws = Sheets("ResultTop3")
    
    
        strSQL = "SELECT *   "
        strSQL = strSQL & " FROM [Data$] as a "
        strSQL = strSQL & "WHERE [Reserves] in ( "
        strSQL = strSQL & "SELECT TOP 3 [Reserves] FROM [Data$] as b "
        strSQL = strSQL & "ORDER BY b.[Reserves] DESC ) "
        strSQL = strSQL & "ORDER BY a.[Reserves] DESC  "
        
            
        exeSQL Ws, strSQL
        
        
    End Sub
    
    Sub sumData()
        Dim Ws As Worksheet
        Dim strSQL As String, strU As String
        Dim sName(1 To 6) As Variant
        Dim i As Integer
        
        Set Ws = Sheets("Data")
    
        For i = 1 To 6
            sName(i) = Sheets(i).Name
        Next i
        For i = 1 To 5
            strU = strU & "select [Customer Group Nr] as [Customer Group], [Volume], [Reserves] from [" & sName(i) & "$] union all "
        Next i
            strU = strU & "select [Customer Group Nr] as [Customer Group], [Volume], [Reserves] from [" & sName(6) & "$] "
            
    
        strSQL = "SELECT [Customer Group], sum([Volume]) as Volume , sum([Reserves]) as Reserves  "
        strSQL = strSQL & " FROM (" & strU & " )"
        strSQL = strSQL & "WHERE not isnull([Volume]) "
        strSQL = strSQL & "GROUP BY [Customer Group]  "
            
        exeSQL Ws, strSQL
        
        
    End Sub
    

    【讨论】:

    • 非常感谢!!但是,excel 给我一个Rs.Open strSQL, strConn 的错误消息我需要下载一些东西吗?谢谢:)
    猜你喜欢
    • 1970-01-01
    • 1970-01-01
    • 2020-07-07
    • 2016-11-23
    • 1970-01-01
    • 1970-01-01
    • 2022-11-11
    • 2021-06-12
    • 2016-07-05
    相关资源
    最近更新 更多