Sub 学生成绩_按钮1_Click()
Set d = CreateObject("scripting.dictionary")
Application.ScreenUpdating = False
For Each sh In Sheets
If InStr(sh.Name, "统计") > 0 Then
sh.UsedRange.Offset(3, 1).ClearContents
nm = Split(sh.Name, "统计")(0)
Set d(nm) = CreateObject("scripting.dictionary")
arr = sh.UsedRange
For j = 4 To UBound(arr)
If Len(arr(j, 1)) > 0 Then d(nm)(arr(j, 1)) = j
Next j
End If
Next sh
arr = Sheets("学生成绩").UsedRange
For j = 4 To UBound(arr)
If Len(arr(j, 1)) > 0 Then
For i = 5 To UBound(arr, 2) - 1
If d.exists(arr(3, i)) Then
r = d(arr(3, i))(arr(j, 1))
shnm = arr(3, i) & "统计"
With Sheets(shnm)
.Cells(r, 2) = .Cells(r, 2) + 1
If Len(arr(j, i)) > 0 Then
.Cells(r, 3) = .Cells(r, 3) + 1
.Cells(r, 4) = .Cells(r, 3) / .Cells(r, 2)
.Cells(r, 5) = .Cells(r, 5) + arr(j, i)
.Cells(r, 6) = .Cells(r, 5) / .Cells(r, 3)
If arr(j, i) >= 90 Then
.Cells(r, 7) = .Cells(r, 7) + 1
.Cells(r, 8) = .Cells(r, 7) / .Cells(r, 3)
Else
If arr(j, i) >= 60 Then
.Cells(r, 9) = .Cells(r, 9) + 1
.Cells(r, 10) = .Cells(r, 9) / .Cells(r, 3)
End If
End If
If .Cells(r, 11) < arr(j, i) Then .Cells(r, 11) = arr(j, i)
If .Cells(r, 12) > arr(j, i) Then .Cells(r, 12) = arr(j, i)
For k = 13 To 20
If arr(j, i) >= Val(.Cells(3, k)) Then
.Cells(r, k) = .Cells(r, k) + 1
GoTo l1
End If
Next k
.Cells(r, 21) = .Cells(r, 21) + 1
l1:
End If
End With
End If
Next i
End If
Next j
Application.ScreenUpdating = True
End Sub
|
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2024-1-26 23:20
楼主
发表于 2024-1-27 08:47
