汇总各班级每科平均分

excelsudel

汇总各班级每科平均分

excelsudel

用字典法只能汇总总分，但平均分不知怎么弄，希望老师帮忙，谢谢了！

hdbk

Sub DoCona() '计算每个班级各科平均分
Sheets("sheet1").Range("h1").CurrentRegion.Clear
Dim con As Object, rs As Object, i&
Set con = CreateObject("adodb.connection")
con.Open "provider=microsoft.ace.oledb.12.0;extended properties=excel 12.0;data source=" & ThisWorkbook.FullName
Sql = "select 班级,avg(语文) as 语文平均分,avg(数学) as 数学平均分,avg(英语) as 英语平均分 from [Sheet1$a1:g] group by 班级"
Set rs = con.Execute(Sql)
For i = 0 To rs.fields.Count - 1
      Sheets("sheet1").Cells(1, i + 8) = rs.fields(i).Name
Next
Sheets("sheet1").Range("h2").CopyFromRecordset rs
rs.Close: Set rs = Nothing
con.Close: Set con = Nothing
End Sub

鄂龙蒙

1. Sub 汇总各班级每科平均分()
   
2.     Dim d, ar, br(), m, i, j
   
3.     Set d = CreateObject("Scripting.Dictionary")
   
4.     Range("H1:K100").ClearContents
   
5.     ar = Range("A1").CurrentRegion
   
6.         For i = 2 To UBound(ar)
   
7.             s = ar(i, 2)
   
8.             If d(s) = "" Then
   
9.                 m = m + 1
   
10.                 ReDim Preserve br(1 To 10, 1 To m)
    
11.                 d(s) = m
    
12.                 br(1, m) = ar(i, 2)
    
13.                 For j = 3 To 5
    
14.                     br(j + 2, m) = ar(i, j)
    
15.                     br(j + 5, m) = 1
    
16.                     br(j - 1, m) = br(j + 2, m) / br(j + 5, m)
    
17.                 Next
    
18.             Else
    
19.                 For j = 3 To 5
    
20.                     br(j + 2, d(s)) = br(j + 2, d(s)) + ar(i, j)
    
21.                     br(j + 5, d(s)) = br(j + 5, d(s)) + 1
    
22.                     br(j - 1, d(s)) = br(j + 2, d(s)) / br(j + 5, d(s))
    
23.                 Next
    
24.             End If
    
25.         Next
    
26.     [H2].Resize(m, 4) = Application.Transpose(br)
    
27.    Set d = Nothing
    
28. End Sub

复制代码

hdbk

用透视表也可以计算平均分

719404338

1. Sub t()
   
2. Dim d, i%, j%, bj, k
   
3. k = 1
   
4. Set d = CreateObject("Scripting.Dictionary")
   
5. For i = 2 To [c65536].End(3).Row
   
6. d(Range("b" & i).Value) = ""
   
7. Next
   
8. For Each bj In d
   
9. If bj = "" Then Exit Sub
   
10. For i = 2 To [c65536].End(3).Row
    
11.    If Range("b" & i) = bj Then
    
12. x = Range("c" & i) + x
    
13. y = Range("d" & i) + y
    
14. Z = Range("e" & i) + Z
    
15. j = j + 1
    
16. End If
    
17. Next i
    
18. Range("f" & k) = bj & "语文平均分：" & x / j
    
19. Range("g" & k) = bj & "数学平均分：" & y / j
    
20. Range("h" & k) = bj & "英语平均分：" & Z / j
    
21. k = k + 1
    
22. Next bj
    
23. End Sub
    

复制代码

excelsudel

719404338 发表于 2018-10-7 20:46

非常满意，谢谢您了，琢磨好久了，也没想出来，最近刚入门，太复杂的语言还没学，您这招我很容易看懂，十分感谢，以后多向您学习。

excelsudel

鄂龙蒙 发表于 2018-10-7 20:27

谢谢啦，您这个方法通俗易懂，以后多向大师学习！

excelsudel

hdbk 发表于 2018-10-7 20:29
用透视表也可以计算平均分

谢谢啦，我正在学VBA

excelsudel

hdbk 发表于 2018-10-7 20:25
Sub DoCona() '计算每个班级各科平均分
Sheets("sheet1").Range("h1").CurrentRegion.Clear
Dim con As O ...

Set con = CreateObject("adodb.connection")
con.Open "provider=microsoft.ace.oledb.12.0;extended properties=excel 12.0;data source=" & ThisWorkbook.FullName
Sql = "select 班级,avg(语文) as 语文平均分,avg(数学) as 数学平均分,avg(英语) as 英语平均分 from [Sheet1$a1:g] group by 班级"
Set rs = con.Execute(Sql)
非常感谢老师，以上代码我还看不懂，刚刚学了CreateObject("scripting.dictionary")，我要好好研究研究。