怎么从每月数据筛选汇总

最爱咥面

ykcbf1100 发表于 2024-8-8 21:28
明天看一下吧。

好的好的，谢谢了

ykcbf1100

最爱咥面 发表于 2024-8-8 23:10
好的好的，谢谢了

改好了。。。

ykcbf1100

加个合计行

1. Sub ykcbf()              '//2024.8.9   保教退费汇总,加个合计行
   
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.         bt = 3
    
43.         .UsedRange.Offset(bt).Clear
    
44.         With .Cells(bt + 1, 1).Resize(m, 17)
    
45.             .Value = brr
    
46.             .Borders.LineStyle = 1
    
47.             .HorizontalAlignment = xlCenter
    
48.             .VerticalAlignment = xlCenter
    
49.         End With
    
50.         For i = bt + 1 To m + bt
    
51.             .Cells(i, 15) = Application.Sum(.Cells(i, 3).Resize(, 12))
    
52.         Next
    
53.         .Cells(bt + 1, 2).Resize(m, 14).Sort .Cells(bt + 1, 2), 1
    
54.         For j = 3 To 15
    
55.             .Cells(bt, j) = Application.Sum(.Cells(bt + 1, j).Resize(m))
    
56.         Next
    
57.         .UsedRange.Offset(m + bt).Clear
    
58.     End With
    
59.     Set d = Nothing
    
60.     Application.ScreenUpdating = True
    
61.     MsgBox "共用时：" & Format(Timer - tm) & "秒！"
    
62. End Sub
    
63. 
    

复制代码

最爱咥面

ykcbf1100 发表于 2024-8-9 07:29
改好了。。。

谢谢了，是我想要的

最爱咥面

ykcbf1100 发表于 2024-8-9 07:34
加个合计行

老师，发现个问题。
这个汇总表里的姓名可不可以改成按班级由低到高排序，不用按首拼音排序。
谢谢

ykcbf1100

最爱咥面 发表于 2024-8-21 16:54
老师，发现个问题。
这个汇总表里的姓名可不可以改成按班级由低到高排序，不用按首拼音排序。
谢谢

改肯定能改，问题是，你这表也没班级啊。

最爱咥面

ykcbf1100 发表于 2024-8-21 16:56
改肯定能改，问题是，你这表也没班级啊。

嗯嗯，这个表里没有班级，但那个名单里是按班级分的。

最爱咥面

ykcbf1100 发表于 2024-8-21 16:56
改肯定能改，问题是，你这表也没班级啊。

老师,
如果不能按那幼儿花名册的班级排序，那就在汇总表里加一列班级
谢谢

ykcbf1100

最爱咥面 发表于 2024-8-21 17:19
老师,
如果不能按那幼儿花名册的班级排序，那就在汇总表里加一列班级
谢谢

你先看一下，是这意思不？

最爱咥面

ykcbf1100 发表于 2024-8-21 18:30
你先看一下，是这意思不？

嗯嗯，像我这样就行
谢谢老师了