怎么从每月数据筛选汇总

最爱咥面

各位老师们帮忙看看
怎么从每月数据筛选汇总

需求：根据每个月的保教或伙食退费表，将有退费数据的填入保教或伙食汇总表，没有数据的不填入
班级按顺序筛选
另外，光用函数能做到么。

ykcbf1100

如果你想光用函数，还是发到函数版去吧。

我个人感觉这个用函数去做比较难。

ykcbf1100

做好一个，伙食退费汇总。
为了有更好的通用性，我改了汇总表的结构，这样，月份增减也不用改代码了。

ykcbf1100

伙食退费汇总。。。

1. Sub ykcbf()              '//2024.8.8   伙食退费汇总
   
2.     Set fso = CreateObject("scripting.filesystemobject")
   
3.     Set d = CreateObject("Scripting.Dictionary")
   
4.     Application.ScreenUpdating = False
   
5.     Dim tm: tm = Timer
   
6.     Set sh = ThisWorkbook.Sheets("伙食汇总")
   
7.     p = ThisWorkbook.Path & ""
   
8.     ReDim brr(1 To 10000, 1 To 17)
   
9.     On Error Resume Next
   
10.     For Each f In fso.GetFolder(p).Files
    
11.         If LCase$(f.Name) Like "*伙食退费*.xls*" Then
    
12.             If InStr(f.Name, ThisWorkbook.Name) = 0 Then
    
13.                 fn = fso.GetBaseName(f)
    
14.                 yf = Val(fn)
    
15.                 n = 2 + yf
    
16.                 Set wb = Workbooks.Open(f, 0)
    
17.                 For Each sht In wb.Sheets
    
18.                     With sht
    
19.                         arr = .UsedRange.Value
    
20.                         Set Rng = .UsedRange.Find("序号")
    
21.                         bt = Rng.Row
    
22.                         For i = bt + 1 To UBound(arr)
    
23.                             If Val(arr(i, 4)) > 0 Then
    
24.                                 s = arr(i, 2)
    
25.                                 If Not d.exists(s) Then
    
26.                                     m = m + 1
    
27.                                     d(s) = m
    
28.                                     brr(m, 1) = m
    
29.                                     brr(m, 2) = s
    
30.                                 End If
    
31.                                 r = d(arr(i, 2))
    
32.                                 brr(r, n) = brr(r, n) + Val(arr(i, 4))
    
33.                             End If
    
34.                         Next
    
35.                     End With
    
36.                 Next
    
37.                 wb.Close False
    
38.             End If
    
39.         End If
    
40.     Next f
    
41.     With sh
    
42.         .UsedRange.Offset(2).Clear
    
43.         With .[a3].Resize(m, 17)
    
44.             .Value = brr
    
45.             .Borders.LineStyle = 1
    
46.             .HorizontalAlignment = xlCenter
    
47.             .VerticalAlignment = xlCenter
    
48.         End With
    
49.         For i = 3 To m + 2
    
50.           .Cells(i, 15) = Application.Sum(.Cells(i, 3).Resize(, 12))
    
51.         Next
    
52.         .[b3].Resize(m, 14).Sort .[b3], 1
    
53.         .UsedRange.Offset(m + 2).Clear
    
54.     End With
    
55.     Set d = Nothing
    
56.     Application.ScreenUpdating = True
    
57.     MsgBox "共用时：" & Format(Timer - tm) & "秒！"
    
58. End Sub
    

复制代码

ykcbf1100

保教退费汇总也做好了。

ykcbf1100

保教退费汇总。。。

1. Sub ykcbf()              '//2024.8.8   保教退费汇总
   
2.     Set fso = CreateObject("scripting.filesystemobject")
   
3.     Set d = CreateObject("Scripting.Dictionary")
   
4.     Application.ScreenUpdating = False
   
5.     Dim tm: tm = Timer
   
6.     Set sh = ThisWorkbook.Sheets(1)
   
7.     p = ThisWorkbook.Path & ""
   
8.     ReDim brr(1 To 10000, 1 To 17)
   
9.     On Error Resume Next
   
10.     For Each f In fso.GetFolder(p).Files
    
11.         If LCase$(f.Name) Like "*保教退费*.xls*" Then
    
12.             If InStr(f.Name, ThisWorkbook.Name) = 0 Then
    
13.                 fn = fso.GetBaseName(f)
    
14.                 yf = Val(fn)
    
15.                 n = 2 + yf
    
16.                 Set wb = Workbooks.Open(f, 0)
    
17.                 For Each sht In wb.Sheets
    
18.                     With sht
    
19.                         arr = .UsedRange.Value
    
20.                         Set Rng = .UsedRange.Find("序号")
    
21.                         bt = Rng.Row
    
22.                         For i = bt + 1 To UBound(arr)
    
23.                             If Val(arr(i, 4)) > 0 Then
    
24.                                 s = arr(i, 2)
    
25.                                 If Not d.exists(s) Then
    
26.                                     m = m + 1
    
27.                                     d(s) = m
    
28.                                     brr(m, 1) = m
    
29.                                     brr(m, 2) = s
    
30.                                 End If
    
31.                                 r = d(arr(i, 2))
    
32.                                 brr(r, n) = brr(r, n) + Val(arr(i, 4))
    
33.                             End If
    
34.                         Next
    
35.                     End With
    
36.                 Next
    
37.                 wb.Close False
    
38.             End If
    
39.         End If
    
40.     Next f
    
41.     With sh
    
42.         .UsedRange.Offset(2).Clear
    
43.         With .[a3].Resize(m, 17)
    
44.             .Value = brr
    
45.             .Borders.LineStyle = 1
    
46.             .HorizontalAlignment = xlCenter
    
47.             .VerticalAlignment = xlCenter
    
48.         End With
    
49.         For i = 3 To m + 2
    
50.           .Cells(i, 15) = Application.Sum(.Cells(i, 3).Resize(, 12))
    
51.         Next
    
52.         .[b3].Resize(m, 14).Sort .[b3], 1
    
53.         .UsedRange.Offset(m + 2).Clear
    
54.     End With
    
55.     Set d = Nothing
    
56.     Application.ScreenUpdating = True
    
57.     MsgBox "共用时：" & Format(Timer - tm) & "秒！"
    
58. End Sub
    
59. 
    

复制代码

kyxfyzg

修改了一下汇总表

最爱咥面

ykcbf1100 发表于 2024-8-8 08:45
保教退费汇总也做好了。

太谢谢ykcbf1100老师了
谢谢帮助

最爱咥面

ykcbf1100 发表于 2024-8-8 08:46
保教退费汇总。。。

老师，汇总表的数据想这样填写

ykcbf1100

最爱咥面 发表于 2024-8-8 20:24
老师，汇总表的数据想这样填写

明天看一下吧。