求助大侠如何统计各学科的过线人数

戎马书生222

求助高手给个思路，学习一下如何完成各学科的普通，重点过线数。谢谢

z865593849

汇总考试分数

xbox1210

练习练习。

戎马书生222

感谢。还有大侠出手吗？

3190496160

Sub 统计()
Dim ar As Variant
Dim d As Object
Set d = CreateObject("scripting.dictionary")
With Sheets("成绩")
    r = .Cells(Rows.Count, 1).End(xlUp).Row
    If r < 2 Then MsgBox "成绩表为空！": End
    ar = .Range("a1:f" & r)
End With
With Sheets("效果")
    rr = .Range("k1:l9")
    rs = .Cells(Rows.Count, 1).End(xlUp).Row
    If rs > 2 Then .Range("a3:i" & rs) = Empty
    br = .Range("a2:i" & r)
    k = 1
    For i = 2 To UBound(ar)
        If ar(i, 1) <> "" Then
            s = ar(i, 1)
            t = d(s)
            If t = "" Then
                k = k + 1
                d(s) = k
                t = k
                br(k, 1) = s
            End If
            y = 2
            For j = 3 To UBound(ar, 2)
                If ar(i, j) <> "" Then
                    If IsNumeric(ar(i, j)) Then
                        fz_1 = rr(y, 2)
                        fz_2 = rr(y + 1, 2)
                        If ar(i, j) >= fz_1 Then
                            br(t, y) = br(t, y) + 1
                        End If
                        If ar(i, j) >= fz_2 Then
                            br(t, y + 1) = br(t, y + 1) + 1
                        End If
                    End If
                End If
                y = y + 2
            Next j
        End If
    Next i
    .[a2].Resize(k, UBound(br, 2)) = br
    .[a2].Resize(k, UBound(br, 2)).Borders.LineStyle = 1
End With
MsgBox "ok!"
End Sub

3190496160

工作簿1.rar (19.58 KB, 下载次数: 9)

2024-11-19 09:51 上传

点击文件名下载附件

usedrange

。。。。。。。。。

戎马书生222

usedrange 发表于 2024-11-19 11:09
。。。。。。。。。

没见程序代码。。。。。。

usedrange

戎马书生222 发表于 2024-11-19 14:45
没见程序代码。。。。。。

在“成绩”工作表下

yanglinzi