|
|
Sub 各班各科均分()
Application.ScreenUpdating = False
Dim d As Object
Dim ar As Variant, br As Variant
Dim i As Long
Dim arr()
Set d = CreateObject("scripting.dictionary")
With Sheets("全部考生成绩汇总")
r = .Cells(Rows.Count, 1).End(xlUp).Row
y = .Cells(3, Columns.Count).End(xlToLeft).Column
ar = .Range(.Cells(1, 1), .Cells(r, y))
End With
m = 0: k = 1
ReDim arr(1 To UBound(ar), 1 To UBound(ar, 2))
For j = 6 To UBound(ar, 2) Step 1
If Trim(ar(2, j)) <> "" Then
m = m + 2
arr(1, m) = ar(2, j)
For i = 4 To UBound(ar)
If Trim(ar(i, 3)) <> "" Then
t = d(Trim(ar(i, 3)))
If t = "" Then
k = k + 1
d(Trim(ar(i, 3))) = k
t = k
arr(k, 1) = ar(i, 3)
End If
If Trim(ar(i, j)) <> "" Then
If IsNumeric(ar(i, j)) Then
arr(t, m) = arr(t, m) + ar(i, j)
arr(t, m + 1) = arr(t, m + 1) + 1
End If
End If
End If
Next i
End If
Next j
ReDim brr(1 To k, 1 To m)
n = 1
brr(1, 1) = "班级/分析"
For i = 2 To k
n = n + 1
brr(n, 1) = arr(i, 1)
w = 1
For j = 2 To m Step 2
w = w + 1
brr(1, w) = arr(1, j)
brr(n, w) = arr(i, j) / arr(i, j + 1)
Next j
Next i
With Sheets("各班各科均分")
.[a1].CurrentRegion = Empty
.[a1].Resize(n, w) = brr
End With
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub
|
|
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2021-9-10 17:11
楼主
