如何在不需要手动汇总三张表的数据，能够得到透视表的数据

minstate

每次都要把标红三个表手动汇总到一个表，然后才能透视得到我想要的数据，想请问下如何在不需要手动汇总三张表的数据，能够得到我想要的数据

hugeinfo

用pq清洗汇总后透视

limonet

你还搞错了

limonet

一步到位，关键字：Union All

limonet

Sub limonet()
    Dim Cn As Object, StrSQL$, Arr As Variant, i%, Sht As Worksheet, Rst As Object
    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 <> "Pivot" Then
            Arr = Application.Transpose(Application.Transpose(Sht.Range("C1:D1")))
            For i = 1 To UBound(Arr)
                StrSQL = StrSQL & " Union All Select 日期,店铺,'" & Arr(i) & "' As 类型," & Arr(i) & " as 数值 From [" & Sht.Name & "$A:D]"
            Next i
        End If
    Next Sht
    Set Rst = Cn.Execute("TransForm Sum(数值) Select 日期,店铺 From (" & Mid(StrSQL, 12) & ") Group By 日期,店铺 Pivot 类型")
    For i = 0 To Rst.Fields.Count - 1
        Cells(1, i + 1) = Rst.Fields(i).Name
    Next i
    Range("A2").CopyFromRecordset Rst
End Sub

我的城市你来过

=LET(m,HSTACK(LET(x,运费!$A$1:$D$11,y,贴标费!$A$1:$D$11,z,装卸费!$A$1:$D$15,UNIQUE(VSTACK(TAKE(x,,2),TAKE(y,,2),TAKE(z,,2)))),HSTACK(运费!$C$1:$D$1,贴标费!$C$1:$D$1,装卸费!$C$1:$D$1)),IFNA(m,""))

cnmlgb9998

PQ不香吗？？？？？？？？？？？？？？？？？？？

ykcbf1100

一键汇总。

附件供参考。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()  '//2024.3.25
   
2.     Application.ScreenUpdating = False
   
3.     Set d = CreateObject("Scripting.Dictionary")
   
4.     fns = [{"运费","贴标费","装卸费"}]
   
5.     Set sh = ThisWorkbook.Sheets("汇总")
   
6.     arr = sh.UsedRange
   
7.     For j = 1 To UBound(arr, 2)
   
8.         s = arr(1, j)
   
9.         d(s) = j
   
10.     Next
    
11.     ReDim brr(1 To 10000, 1 To UBound(arr, 2))
    
12.     For Each sht In Sheets(fns)
    
13.         With sht
    
14.             arr = .UsedRange
    
15.             For i = 2 To UBound(arr)
    
16.                 If arr(i, 1) <> Empty Then
    
17.                     m = m + 1
    
18.                     For j = 1 To UBound(arr, 2)
    
19.                         s = arr(1, j)
    
20.                         If d.exists(s) Then
    
21.                             brr(m, d(s)) = arr(i, j)
    
22.                         End If
    
23.                     Next
    
24.                 End If
    
25.             Next
    
26.         End With
    
27.     Next
    
28.     With sh
    
29.         .UsedRange.Offset(1).ClearContents
    
30.         .[a2].Resize(m, UBound(brr, 2)) = brr
    
31.         .[a2].Resize(m, UBound(brr, 2)).Borders.LineStyle = 1
    
32.     End With
    
33.     Set d = Nothing
    
34.     Application.ScreenUpdating = True
    
35.     MsgBox "OK！"
    
36. End Sub
    

复制代码

minstate

limonet 发表于 2024-3-25 16:20
一步到位，关键字：Union All

点击按钮显示找不到工程和库