VBA: суммировать одинаковые столбцы с нескольких листов на другом листе (обзор)

#excel #vba #sum #sumifs

#преуспеть #vba #сумма #sumifs

Вопрос:

Я новичок в VBA и хотел бы быстро учиться 🙂

У меня есть 6 листов Excel (месяцы 1-6) с одинаковыми данными (показаны в виде таблицы), но с разным количеством строк.

введите описание изображения здесь

  1. Я хотел бы создать таблицу с месяцами (1-6) в виде строк, а объемы и резервы в виде столбцов

введите описание изображения здесь

  1. Кроме того, есть ли способ, которым я могу написать код, который дает мне 3 лучшие группы клиентов с точки зрения резервов (столбец F), который также дает соответствующий объем (столбец E) — как sumif(), но в vba?

введите описание изображения здесь

Я занимался исследованиями в течение нескольких дней и почти ничего не нашел…Я рад любой помощи, которую я могу получить! Большое вам спасибо:)

Ответ №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;" amp; _
        "Data Source=" amp; ThisWorkbook.FullName amp; ";" amp; _
            "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 amp; "select '" amp; sName(i) amp; "' as sday, [Volume], [Reserves] from [" amp; sName(i) amp; "$] union all "
    Next i
        strU = strU amp; "select '" amp; sName(6) amp; "' as sday, [Volume], [Reserves] from [" amp; sName(6) amp; "$] "
        
    strSQL = "SELECT sday, sum([Volume]) as [sum of volume], sum([Reserves]) as [sum of Reserves ] "
    strSQL = strSQL amp; " FROM (" amp; strU amp; " )"
    strSQL = strSQL amp; "WHERE not isnull([Volume]) "
    strSQL = strSQL amp; "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 amp; " FROM [Data$] as a "
    strSQL = strSQL amp; "WHERE [Reserves] in ( "
    strSQL = strSQL amp; "SELECT TOP 3 [Reserves] FROM [Data$] as b "
    strSQL = strSQL amp; "ORDER BY b.[Reserves] DESC ) "
    strSQL = strSQL amp; "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 amp; "select [Customer Group Nr] as [Customer Group], [Volume], [Reserves] from [" amp; sName(i) amp; "$] union all "
    Next i
        strU = strU amp; "select [Customer Group Nr] as [Customer Group], [Volume], [Reserves] from [" amp; sName(6) amp; "$] "
        

    strSQL = "SELECT [Customer Group], sum([Volume]) as Volume , sum([Reserves]) as Reserves  "
    strSQL = strSQL amp; " FROM (" amp; strU amp; " )"
    strSQL = strSQL amp; "WHERE not isnull([Volume]) "
    strSQL = strSQL amp; "GROUP BY [Customer Group]  "
        
    exeSQL Ws, strSQL
    
    
End Sub
 

Комментарии:

1. большое вам спасибо!! однако Excel выдает мне сообщение об ошибке Rs.Open strSQL, strConn , нужно ли мне что-то загружать? Спасибо 🙂