按日期将两个工作表的数据汇总在一起

kort20034

我想将两个工作表的相同日期的金额按条件加起来分两列汇总在一起，我只能实现单个工作表汇总，求两个工作表的数据同时汇总。

ykcbf1100

全表自动生成，工作表、数据增减不用改代码。

ykcbf1100

参与一下。。。

xlj310

现在的公式~

z865593849

汇总数据........

quqiyuan

参与一下，仅供参考，，，

结果跟楼主模拟有点出入

quqiyuan

待明如下。。。
Sub test()
    Dim wb As Workbook, sht As Worksheet
    Set wb = ThisWorkbook
    Set sht = wb.Sheets("统计表")
    arr = sht.Range("b1:b" & sht.Cells(Rows.Count, 2).End(3).Row)
    Set d = CreateObject("scripting.dictionary")
    For i = 2 To UBound(arr)
        s = arr(i, 1)
        d(s) = i
    Next
    ReDim crr(1 To UBound(arr), 1 To 100)
    For Each sh In wb.Sheets
        If sh.Name <> sht.Name Then
            brr = sh.[a1].CurrentRegion
            If IsArray(brr) Then
                m = m + 1
                crr(1, m) = sh.Name
                For i = 2 To UBound(brr)
                    If d.exists(brr(i, 1)) Then
                        crr(d(brr(i, 1)), m) = crr(d(brr(i, 1)), m) + brr(i, 2)
                    End If
                Next
            End If
        End If
    Next
    sht.[c1].Resize(UBound(crr), m) = crr
    Beep
    Set d = Nothing
End Sub

limonet

Sub limonet()
    Dim Cn As Object, StrSQL$, Sht As Worksheet
    Set Cn = CreateObject("Adodb.Connection")
    Cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0;Data Source=" & ThisWorkbook.FullName
    For Each Sht In Worksheets
        If Sht.Name <> ActiveSheet.Name Then
            StrSQL = StrSQL & " Union ALl Select 日期,Sum(金额) as Amount,'" & Sht.Name & "' as 支出 From [" & Sht.Name & "$] Group By 日期"
        End If
    Next Sht
    StrSQL = "TransForm Sum(Amount) Select 日期 From (" & Mid(StrSQL, 12) & ") Group By 日期 Pivot 支出"
    Range("B2").CopyFromRecordset Cn.Execute(StrSQL)
End Sub

limonet

关键字：group by+union all+pivot

Qs18

1. Sub qs()
   
2. Dim arr, i, dic
   
3. Set dic = CreateObject("scripting.dictionary")
   
4. ReDim brr(1 To 20000, 1 To 3)
   
5. m = 1
   
6. a = [{"A支出","B支出"}]
   
7. For i = 1 To UBound(a)
   
8.     arr = Sheets(a(i)).UsedRange.Value
   
9.     For ii = 2 To UBound(arr)
   
10.     dt = Format(CDate(arr(ii, 1)), "yyyy/mm")
    
11.         If Not dic.exists(dt) Then
    
12.             m = m + 1
    
13.             dic(dt) = m
    
14.             brr(m, 1) = dt
    
15.             If i = 1 Then brr(m, 2) = arr(ii, 2) Else brr(m, 3) = arr(ii, 2)
    
16.         Else
    
17.             rw = dic(dt)
    
18.             If i = 1 Then brr(rw, 2) = brr(rw, 2) + arr(ii, 2) Else brr(rw, 3) = brr(rw, 3) + arr(ii, 2)
    
19.         End If
    
20.     Next ii
    
21. Next
    
22. brr(1, 1) = "日期": brr(1, 2) = "A支出": brr(1, 3) = "B支出"
    
23. With Sheets("统计表")
    
24. .[b1].Resize(20000, 3) = Empty
    
25. .[b1].Resize(m - 1, 3) = brr
    
26. End With
    
27. Set dic = Nothing
    
28. End Sub
    

复制代码