分类汇总求平均分

奋斗000

求助大神，帮忙统计各学校的各个班级人数，各学科平均分。

明天会更好zj

这个还是公式简单一点

奋斗000

明天会更好zj 发表于 2024-8-30 20:57
这个还是公式简单一点

主要是想学习一下用VBA如何统计

chxw68

1. Sub test()
   
2.     Dim r%, i%
   
3.     Dim arr, brr
   
4.     Dim d As Object
   
5.     Application.ScreenUpdating = False
   
6.     Application.DisplayAlerts = False
   
7.     Set d = CreateObject("scripting.dictionary")
   
8.     ls = 14
   
9.     With Worksheets("数据源")
   
10.         .AutoFilterMode = False
    
11.         r = .Cells(.Rows.Count, 1).End(xlUp).Row
    
12.         c = .Cells(1, .Columns.Count).End(xlToLeft).Column
    
13.         arr = .Range("a2").Resize(r - 1, c)
    
14.     End With
    
15.     For i = 1 To UBound(arr)
    
16.         xm = arr(i, 25) & "+" & arr(i, 1) & "+" & arr(i, 2)
    
17.         If Not d.exists(xm) Then
    
18.             ReDim brr(1 To ls)
    
19.             brr(1) = arr(i, 25)
    
20.             brr(2) = arr(i, 1)
    
21.             brr(3) = arr(i, 2)
    
22.         Else
    
23.             brr = d(xm)
    
24.         End If
    
25.         brr(4) = brr(4) + 1
    
26.         For j = 5 To 14
    
27.             If IsNumeric(arr(i, j)) Then
    
28.                 brr(j) = brr(j) + arr(i, j)
    
29.             End If
    
30.         Next
    
31.         d(xm) = brr
    
32.     Next
    
33.     ReDim crr(1 To d.Count, 1 To ls)
    
34.     m = 0
    
35.     For Each aa In d.keys
    
36.         brr = d(aa)
    
37.         If Len(brr(4)) <> 0 And brr(4) <> 0 Then
    
38.             For j = 5 To UBound(brr)
    
39.                 brr(j) = Application.Round(brr(j) / brr(4), 2)
    
40.             Next
    
41.         End If
    
42.         m = m + 1
    
43.         For j = 1 To UBound(brr)
    
44.             crr(m, j) = brr(j)
    
45.         Next
    
46.     Next
    
47.     With Worksheets("结果")
    
48.         .UsedRange.Offset(2, 0).Clear
    
49.         .Range("a3").Resize(UBound(crr), UBound(crr, 2)) = crr
    
50.         .Range("a3").Resize(UBound(crr), UBound(crr, 2)).Sort key1:=.Cells(3, 1), order1:=xlAscending, key2:=.Cells(3, 2), order2:=xlAscending, key3:=.Cells(3, 3), order3:=xlAscending, Header:=xlNo
    
51.         With .Range("a2").Resize(1 + UBound(crr), UBound(crr, 2))
    
52.             .Borders.LineStyle = xlContinuous
    
53.             With .Font
    
54.                 .Name = "微软雅黑"
    
55.                 .Size = 10
    
56.             End With
    
57.         End With
    
58.         With .UsedRange
    
59.             .HorizontalAlignment = xlCenter
    
60.             .VerticalAlignment = xlCenter
    
61.         End With
    
62.         .Rows(2).Resize(1 + UBound(crr)).RowHeight = 18
    
63.     End With
    
64. End Sub
    

复制代码

chxw68

详见附件。

奋斗000

chxw68 发表于 2024-8-30 21:06
详见附件。

非常感谢，完全正确的

cai2532

留下脚印学习了