【求助】VBA按班级求各科平均分

光和色

sdytsxd991122 发表于 2022-12-15 15:27
Sub sdyt()
    On Error Resume Next
    arr = Sheet1.Range("a2").CurrentRegion

特别特别感谢老师   非常精准的解决了问题

良良

光和色 发表于 2022-12-13 19:01
老师 您好  感谢您的帮助，我用您的代码已经成功了，还想再麻烦问您一下，如果需要在7班下面加一行年级的 ...

=IFERROR(AVERAGE(OFFSET(Sheet1!$A:$A,,MATCH(B$1&"*",Sheet1!$2:$2,)-1)),"")

光和色

良良 发表于 2022-12-18 11:19
=IFERROR(AVERAGE(OFFSET(Sheet1!$A:$A,,MATCH(B$1&"*",Sheet1!$2:$2,)-1)),"")

谢谢老师

tanglf188

参与一下练练手，数组+EXCEl函数写法，添加行数不影响代码，取数和写入修改数组对应关系即可
Sub cal()
    Dim arr As Variant, counrow As Integer
    arr = [{"H","C"; "K","E" ;"N","G";"Q" ,"I";"T","K";"W","M";"Z","S"}] '二维数组，第一列为成绩所在列，第二列为待写入的列，可自己向后添加
    counrow1 = Sheets(1).UsedRange.Rows.Count + 1
    counrow2 = Sheets(2).UsedRange.Rows.Count
    For x = 1 To UBound(arr, 1)
        For i = 3 To counrow2
            tota = Application.SumIfs(Sheets(1).Range(arr(x, 1) & 3 & ":" & arr(x, 1) & counrow1), Sheets(1).Range("D3:D" & counrow1), Sheets(2).Range("A" & i)) '班级单科总分
            quan = Application.CountIfs(Sheets(1).Range("D3:D" & counrow1), Sheets(2).Range("A" & i), Sheets(1).Range(arr(x, 1) & 3 & ":" & arr(x, 1) & counrow1), ">0") '班级成绩大于0人数
            With Sheets(2).Range(arr(x, 2) & i)
                If tota * quan > 0 Then .Value = tota / quan '平均分
                .NumberFormatLocal = "0.00_ " '单元格格式
                .HorizontalAlignment = xlRight '水平靠右
                .VerticalAlignment = xlCenter '垂直居中
            End With
        Next
    Next
End Sub