成绩统计问题。

春风360

哪位大神指导一下，我自己做的成绩统计系统，原来做了语文数学和英语三科的统计表，现在又加了科学和道法的，表册复制后不自动统计科学和道法的成绩（要把所有成绩统计到工作表2统计中去）。表册做好了，现在就是科学和道法的统计表的公式不合适，试了好几次都不行。请大神看一下啊。谢谢了！

quqiyuan

需要定义名称：

例如，科学表格这里，公式都要改的

道法这里一样道理

沈默00

自己做的也搞不明白？

春风360

quqiyuan 发表于 2024-7-17 12:57
需要定义名称：

例如，科学表格这里，公式都要改的

能帮我做一下吗，完了发给我

quqiyuan

春风360 发表于 2024-7-17 14:18
能帮我做一下吗，完了发给我

改了下，不过里面的优良率，及格率那些要你自己改咯，由于不知道分数怎么划分，它们跟上面三科应该不一样的，造成了都是0

3190496160

这个帖子基本能满足你的需求
成绩分析模板-Excel VBA程序开发-ExcelHome技术论坛 -  https://club.excelhome.net/threa ... tml?_dsign=1b3f3e88

3190496160

Sub 成绩分析()
Application.ScreenUpdating = False
Dim ar As Variant
Dim d As Object, dc As Object
Set d = CreateObject("scripting.dictionary")
Set dc = CreateObject("scripting.dictionary")
With Sheets("统计人")
    br = .Range("a2:f6")
    xx = .[c8]
End With
For i = 1 To UBound(br)
    If br(i, 1) <> "" Then
        d(br(i, 1)) = i
    End If
Next i
With Sheets("科任教师")
    rs = .Cells(Rows.Count, 2).End(xlUp).Row
    If rs < 2 Then MsgBox "科任教师表为空！": End
    cr = .Range("a2:f" & rs)
End With
For i = 2 To UBound(cr)
    If cr(i, 1) <> "" Then
        For j = 2 To UBound(cr, 2)
            If cr(1, j) <> "" Then
                zd = cr(i, 1) & "|" & cr(1, j)
                d(zd) = cr(i, j)
            End If
        Next j
    End If
Next i
With Sheets("成绩")
    r = .Cells(Rows.Count, 2).End(xlUp).Row
    If r < 2 Then MsgBox "成绩表为空！": End
    ar = .Range("a1:m" & r)
End With
With Sheets("统计")
    .UsedRange.Offset(3).Clear
    For j = 5 To 9
        k = 0: dc.RemoveAll
        ReDim arr(1 To UBound(ar), 1 To 17)
        For i = 2 To UBound(ar)
            If ar(i, 2) <> "" Then
                t = dc(ar(i, 2))
                If t = "" Then
                    k = k + 1
                    dc(ar(i, 2)) = k
                    t = k
                    arr(k, 1) = ar(i, 2)
                End If
                arr(t, 2) = arr(t, 2) + 1
                If ar(i, j) <> "" Then
                    If IsNumeric(ar(i, j)) Then
                        If ar(i, j) > 0 Then
                            arr(t, 3) = arr(t, 3) + 1 '''计算参考人数
                            If ar(i, j) >= 80 Then
                                arr(t, 4) = arr(t, 4) + 1 '''计算优良人数
                            End If
                            If ar(i, j) >= 60 Then
                                arr(t, 6) = arr(t, 6) + 1 '''计算及格人数
                            End If
                            If ar(i, j) <= 35 Then
                                arr(t, 8) = arr(t, 8) + 1 '''计算过差人数
                            End If
                        End If
                        arr(t, 12) = arr(t, 12) + ar(i, j) '''计算总分
                        If arr(t, 10) = "" Then
                            arr(t, 10) = ar(i, j)
                        Else
                            If ar(i, j) > arr(t, 10) Then
                                arr(t, 10) = ar(i, j)
                            End If
                        End If ''计算最高分
                        If arr(t, 11) = "" Then
                            arr(t, 11) = ar(i, j)
                        Else
                            If ar(i, j) < arr(t, 11) Then
                                arr(t, 11) = ar(i, j)
                            End If
                        End If ''计算最低分
                    End If
                End If
            End If
        Next i
        For i = 1 To k
            If arr(i, 4) = 0 Then
                arr(i, 5) = 0
            Else
                arr(i, 5) = arr(i, 4) / arr(i, 3) * 100
            End If '''优良率
            If arr(i, 6) = 0 Then
                arr(i, 7) = 0
            Else
                arr(i, 7) = arr(i, 6) / arr(i, 3) * 100
            End If '''及格率
            If arr(i, 8) = 0 Then
                arr(i, 9) = 0
            Else
                arr(i, 9) = arr(i, 8) / arr(i, 3) * 100
            End If '''过差率
            arr(i, 13) = arr(i, 12) / arr(i, 3) ''平均分
            zf = arr(i, 1) & "|" & ar(1, j)
            arr(i, 14) = d(zf)
            arr(i, 15) = ((arr(i, 5) + arr(i, 9) + 100) / 2 + arr(i, 7) + arr(i, 13)) / 3
        Next i
        xh = d(ar(1, j))
        If j = 5 Then
            ws = 1
        Else
            ws = .Cells(Rows.Count, 1).End(xlUp).Row + 1
        End If
        If j > 5 Then .Rows("1:3").Copy .Cells(ws, 1)
        .Cells(ws, 1) = xx & "   " & ar(1, j) & "   考试成绩统计表"
        .Cells(ws + 3, 1).Resize(k, UBound(arr, 2)) = arr
        .Cells(ws + 3, 1).Resize(k + 2, UBound(arr, 2)).Borders.LineStyle = 1
        .Cells(k + ws + 4, 1) = "学区汇总"
        For jj = 2 To 12
            If jj <> 5 And jj <> 7 And jj <> 9 And jj <> 10 And jj <> 11 Then
                .Cells(k + ws + 4, jj) = Application.Sum(Application.Index(arr, 0, jj))
            End If
        Next jj
        .Cells(k + ws + 4, 10) = Application.Max(Application.Index(arr, 0, 10))
        .Cells(k + ws + 4, 11) = Application.Min(Application.Index(arr, 0, 11))
         For jj = 5 To 9
            If jj <> 6 And jj <> 8 Then
                .Cells(k + ws + 4, jj) = .Cells(k + 1 + 4, jj - 1) / .Cells(k + 1 + 4, 3) * 100
            End If
        Next jj
        .Cells(k + ws + 4, 13) = .Cells(k + ws + 4, 12) / .Cells(k + ws + 4, 3)
        .Cells(k + ws + 5, 9) = "组长："
        .Cells(k + ws + 5, 10) = br(xh, 3)
        .Cells(k + ws + 5, 11) = "统计人："
        .Cells(k + ws + 5, 12) = br(xh, 5)
        .Cells(k + ws + 5, 13) = br(xh, 6)
        .Cells(k + ws + 5, 1) = "综合指数z=[(100+优良率－过差率)/2+及格率+平均分]/3。"
        For i = ws + 3 To k + ws + 2
            .Cells(i, 16) = Application.Rank(.Cells(i, 15), .Range("o" & ws + 3 & ":o" & k + ws + 3))
        Next i
    Next j
    .Activate
End With
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub

3190496160

vba完成的，供参考
新成绩统计系统2222.rar (51.65 KB, 下载次数: 4)

2024-7-17 18:20 上传

点击文件名下载附件

春风360

3190496160 发表于 2024-7-17 18:21
vba完成的，供参考

非常感谢！！

春风360

quqiyuan 发表于 2024-7-17 14:48
改了下，不过里面的优良率，及格率那些要你自己改咯，由于不知道分数怎么划分，它们跟上面三科应该不一样 ...

非常感谢！！