求助：如何在七年级工作表中（不要添加辅助列算总分），用VBA求出各学校七科总分成...

cai2532

求助：如何在七年级工作表中（不要添加辅助列算总分），用VBA求出各学校七科总分成绩的最高分和最低分放在统计表相关单元格里？谢谢！

3190496160

Sub 计算()
Application.ScreenUpdating = False
Dim ar As Variant
Dim d As Object
Dim br(), brr()
Set d = CreateObject("scripting.dictionary")
With ActiveSheet
    r = .Cells(Rows.Count, 1).End(xlUp).Row
    If r < 3 Then MsgBox "成绩表为空！": End
    ar = .Range("a2:r" & r)
    For i = 2 To UBound(ar)
        zf = 0
        If Trim(ar(i, 1)) <> "" Then
            For j = 4 To UBound(ar, 2) - 1 Step 2
                If Trim(ar(i, j)) <> "" Then
                    If IsNumeric(ar(i, j)) Then
                        zf = zf + ar(i, j)
                    End If
                End If
            Next j
            ar(i, 18) = zf
            d(Trim(ar(i, 1))) = d(Trim(ar(i, 1))) + 1
        End If
    Next i
    .[r2].Resize(UBound(ar), 1) = Application.Index(ar, 0, 18)
    .[r2] = "总分"
End With
ReDim br(1 To d.Count, 1 To 5)
For Each k In d.keys
    n = 0: m = m + 1
    ReDim brr(1 To d.Count, 1 To 1)
    For i = 2 To UBound(ar)
        If Trim(ar(i, 1)) = k Then
            n = n + 1
            brr(n, 1) = ar(i, 18)
        End If
    Next i
    br(m, 1) = m
    br(m, 2) = k
    br(m, 3) = d(k)
    br(m, 4) = Application.Max(brr)
    br(m, 5) = Application.Min(brr)
Next k
With Sheets("统计表")
    .[a1].CurrentRegion.Offset(2) = Empty
    .[a3].Resize(m, UBound(br, 2)) = br
End With
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub

3190496160

学生成绩录入表.rar (21.62 KB, 下载次数: 7)

2023-4-29 22:26 上传

点击文件名下载附件

cjc209

Sub 统计()
    Dim i, j, k, arr, brr, x, y
    Dim dic
    Set dic = CreateObject("scripting.dictionary")
    arr = Sheets("七年级").[a1].CurrentRegion
    For i = 3 To UBound(arr)
        关键字 = arr(i, 1)
        总分 = arr(i, 4) + arr(i, 6) + arr(i, 8) + arr(i, 10) + arr(i, 12) + arr(i, 14) + arr(i, 16)
        If Not dic.exists(关键字) Then
            dic(关键字) = Array(关键字, 1, 总分, 总分)
        Else
            t = dic(关键字)
            高分 = IIf(总分 > t(2), 总分, t(2))
            低分 = IIf(总分 < t(3), 总分, t(3))
            dic(关键字) = Array(关键字, t(1) + 1, 高分, 低分)
        End If
    Next
    Sheets("统计表").Range("b4").Resize(1000, 4) = ""
    Sheets("统计表").Range("b4").Resize(dic.Count, 4) = Application.Rept(dic.items, 1)
End Sub

gwjkkkkk

请参考。。。

cai2532

3190496160 发表于 2023-4-29 22:25
Sub 计算()
Application.ScreenUpdating = False
Dim ar As Variant

感谢大神一如既往的帮助，已经送花表心意！！！

cai2532

cjc209 发表于 2023-4-29 22:46
Sub 统计()
    Dim i, j, k, arr, brr, x, y
    Dim dic

非常感谢，已经送花表心意！！！

cai2532

gwjkkkkk 发表于 2023-4-29 22:54
请参考。。。

非常感谢，效果很理想。已送花表示心意。