多表格汇总为一个表格

yxw4029

查了好多资料，还是不懂，帮帮忙~！

guange99

哇，数据透视表

yangrongguan

....................

yxw4029

和我想要的不同啊~
我要汇总后按日期排列好筛选的，要是各销售点能按日期排列并汇总更好。。

yangrongguan

......................

yxw4029

谢谢！

YANGRJ

有点晕

dengxiuhua

打下能吧具体怎么做的告诉一下就好了

ykcbf1100

VBA，借题练习

有个坑，字段名列号不固定

ykcbf1100

1. Sub ykcbf()         '//2025.3.26
   
2.     Application.ScreenUpdating = False
   
3.     Application.DisplayAlerts = False
   
4.     Set fso = CreateObject("Scripting.FileSystemObject")
   
5.     Dim arr, brr(1 To 10000, 1 To 3)
   
6.     p = ThisWorkbook.Path & ""
   
7.     Set sh = Sheets("Sheet1")
   
8.     On Error Resume Next
   
9.     For Each f In fso.GetFolder(p).Files
   
10.         If LCase$(f.Name) Like "*.xls*" Then
    
11.             If InStr(f.Name, ThisWorkbook.Name) = 0 Then
    
12.                 Set wb = Workbooks.Open(f, 0)
    
13.                 With wb.Sheets(1)
    
14.                     arr = .UsedRange
    
15.                     c1 = .Rows(1).Find("销售点").Column
    
16.                     c2 = .Rows(1).Find("日期").Column
    
17.                 End With
    
18.                 wb.Close False
    
19.                 For i = 2 To UBound(arr)
    
20.                     If arr(i, 1) <> Empty Then
    
21.                         m = m + 1
    
22.                         brr(m, 1) = arr(i, 1)
    
23.                         brr(m, 2) = arr(i, c1)
    
24.                         brr(m, 3) = arr(i, c2)
    
25.                     End If
    
26.                 Next
    
27.             End If
    
28.         End If
    
29.     Next
    
30.     With sh
    
31.         .UsedRange.Offset(1).ClearContents
    
32.         .[a2].Resize(m, 3) = brr
    
33.     End With
    
34.     Application.ScreenUpdating = True
    
35.     MsgBox "OK！"
    
36. End Sub
    
37. 
    

复制代码