分班级计算出每班每科的平均分

雄飞的小鸡

大神求教，分班级计算出每班每科的平均分，包括学科的总平均分

雄飞的小鸡

大神求指教

雄飞的小鸡

雄飞的小鸡 发表于 2019-6-15 15:43
大神求指教

求教，求教，求教

chxw68

1. Sub test()
   
2.   Dim r%, i%
   
3.   Dim arr, brr
   
4.   Dim d As Object
   
5.   Set d = CreateObject("scripting.dictionary")
   
6.   With Worksheets("sheet1")
   
7.     r = .Cells(.Rows.Count, 1).End(xlUp).Row
   
8.     arr = .Range("a2:k" & r)
   
9.     For i = 1 To UBound(arr)
   
10.       If Not d.exists(arr(i, 2)) Then
    
11.         ReDim brr(1 To 10)
    
12.       Else
    
13.         brr = d(arr(i, 2))
    
14.       End If
    
15.       brr(1) = brr(1) + 1
    
16.       For j = 4 To UBound(arr, 2)
    
17.         brr(j - 2) = brr(j - 2) + arr(i, j)
    
18.       Next
    
19.       d(arr(i, 2)) = brr
    
20.     Next
    
21.     ReDim drr(1 To UBound(brr))
    
22.     m = 1
    
23.     For Each aa In d.keys
    
24.       brr = d(aa)
    
25.       For j = 1 To UBound(brr)
    
26.         drr(j) = drr(j) + brr(j)
    
27.       Next
    
28.       For j = 2 To UBound(brr) - 1
    
29.         brr(10) = brr(10) + brr(j)
    
30.       Next
    
31.       If Len(brr(1)) <> 0 And brr(1) <> 0 Then
    
32.         For j = 2 To UBound(brr)
    
33.           brr(j) = Round(brr(j) / brr(1), 2)
    
34.         Next
    
35.         brr(1) = aa
    
36.       End If
    
37.       m = m + 1
    
38.       .Cells(m, 15).Resize(1, UBound(brr)) = brr
    
39.     Next
    
40.     For j = 2 To UBound(drr) - 1
    
41.       drr(10) = drr(10) + drr(j)
    
42.     Next
    
43.     If Len(drr(1)) <> 0 And drr(1) <> 0 Then
    
44.       For j = 2 To UBound(drr)
    
45.         drr(j) = Round(drr(j) / drr(1), 2)
    
46.       Next
    
47.     End If
    
48.     drr(1) = "科目总平均值"
    
49.     m = m + 1
    
50.     .Cells(m, 15).Resize(1, UBound(drr)) = drr
    
51.   End With
    
52. End Sub
    

复制代码

chxw68

详见附件。

zpy2

SELECT 班级,avg(数学),avg(语文) FROM [年级成绩单] GROUP BY 班级

爱吃蜂蜜的狼

1. Sub test()
   
2.     Set d = CreateObject("scripting.Dictionary")
   
3.     Dim ar1(), n%, a, i
   
4.     k = Sheet1.Range("a:a").Find("*", , , , , xlPrevious).Row
   
5.     Sheet1.Range("o1:x" & k) = ""
   
6.     arr = Sheet1.Range("b1:k" & k)
   
7.     For i = 1 To k
   
8.         d.Item(arr(i, 1)) = ""
   
9.     Next
   
10.     ar = d.Keys
    
11.     For Each a In ar
    
12.         n = n + 1
    
13.         ReDim Preserve ar1(1 To 10, 1 To n)
    
14.         For ii = 1 To k
    
15.             If arr(ii, 1) = a Then
    
16.                 ar1(1, n) = a
    
17.                 ar1(2, n) = ar1(2, n) + arr(ii, 2)
    
18.                 ar1(3, n) = ar1(3, n) + arr(ii, 3)
    
19.                 ar1(4, n) = ar1(4, n) + arr(ii, 4)
    
20.                 ar1(5, n) = ar1(5, n) + arr(ii, 5)
    
21.                 ar1(6, n) = ar1(6, n) + arr(ii, 6)
    
22.                 ar1(7, n) = ar1(7, n) + arr(ii, 7)
    
23.                 ar1(8, n) = ar1(8, n) + arr(ii, 8)
    
24.                 ar1(9, n) = ar1(9, n) + arr(ii, 9)
    
25.                 ar1(10, n) = ar1(10, n) + arr(ii, 10)
    
26.                 y = y + 1
    
27.             End If
    
28.         Next
    
29.         If n <> 1 Then
    
30.             ar1(2, n) = ar1(2, n) / y
    
31.             ar1(3, n) = ar1(3, n) / y
    
32.             ar1(4, n) = ar1(4, n) / y
    
33.             ar1(5, n) = ar1(5, n) / y
    
34.             ar1(6, n) = ar1(6, n) / y
    
35.             ar1(7, n) = ar1(7, n) / y
    
36.             ar1(8, n) = ar1(8, n) / y
    
37.             ar1(9, n) = ar1(9, n) / y
    
38.             ar1(10, n) = ar1(10, n) / y
    
39.         End If
    
40.         y = 0
    
41.     Next
    
42.     ar2 = Application.Transpose(ar1)
    
43.     Sheet1.Range("o1").Resize(UBound(ar2), UBound(ar2, 2)) = ar2
    
44.     k1 = Sheet1.Range("p:p").Find("*", , , , , xlPrevious).Row
    
45.     Sheet1.Range("o" & k1 + 1) = "科目总平均"
    
46.     Sheet1.Range("o" & k1 + 1).Select
    
47.     For iii = 2 To UBound(ar2, 2)
    
48.         For i1 = 2 To k1
    
49.             m = m + ar2(i1, iii)
    
50.         Next
    
51.         x = x + 1
    
52.         Selection.Offset(, x) = m / (k1 - 1)
    
53.             m = 0
    
54.         Next
    
55.         Sheet1.Range("o2:o" & k1).Sort [o2], xlAscending
    
56. End Sub
    

复制代码

一把小刀闯天下

Option Explicit

Sub test()
  Dim arr, i, j, k, kk, m, sum, total
  arr = [a1].CurrentRegion.Offset(1)
  ReDim total(3 To UBound(arr, 2))
  Call dsort(arr, 1, UBound(arr, 1) - 1, 1, UBound(arr, 2), 2)
  For i = 1 To UBound(arr, 1) - 1
    For j = i To UBound(arr, 1) - 1
      If arr(j, 2) <> arr(j + 1, 2) Then
        ReDim sum(3 To UBound(arr, 2))
        For k = 3 To UBound(arr, 2)
          For kk = i To j
            sum(k) = sum(k) + arr(kk, k)
            total(k) = total(k) + arr(kk, k)
        Next kk, k
        m = m + 1: arr(m, 1) = arr(i, 2)
        For k = 2 To UBound(arr, 2) - 1
          arr(m, k) = Round(sum(k + 1) / (j - i + 1), 2)
        Next
        i = j: Exit For
      End If
  Next j, i
  m = m + 1: arr(m, 1) = "科目总平均分"
  For i = 2 To UBound(arr, 2) - 1
    arr(m, i) = Round(total(i + 1) / (UBound(arr, 1) - 1), 2)
  Next
  [b1].Resize(, UBound(arr, 2) - 1).Copy [o1]
  With [o2]
    .Resize(Rows.Count - 1, UBound(arr, 2)).ClearContents
    .Resize(m, UBound(arr, 2) - 1) = arr
  End With
End Sub

Function dsort(arr, first, last, left, right, key)
  Dim i, j, k, t
  For i = first To last - 1
    For j = i + 1 To last
      If arr(i, key) > arr(j, key) Then
        For k = left To right
          t = arr(i, k): arr(i, k) = arr(j, k): arr(j, k) = t
        Next
      End If
  Next j, i
End Function

excelhomesnake

想问问楼主，为什么 除了语数英，其他科目的最高分就60？物理最高是61分

micch

1. =AVERAGEIF($B:$B,$O2,D:D)

复制代码

函数版，P2右拉下拉，