|
Dim a&, b&, i&
With Sheets("等级")
a = .Range("A65536").End(xlUp).Row '确定需要统计数据的列号
For b = 14 To 22 '确定转换等级后所要复制数据所在行号
For i = 3 To .Range("A65536").End(xlUp).Row '确定有效数据列号范围
.Cells(i, 11) = Application.Sum(Range(.Cells(i, 3), .Cells(i, 6))) '统计语数英物四门总分
.Cells(i, 12) = Application.Sum(Range(.Cells(i, 3), .Cells(i, 10))) '统计语数英物生政历地八门总分
.Cells(i, b) = Application.Rank(.Cells(i, b - 11), Range(.Cells(3, b - 11), .Cells(a, b - 11)), 0) '排位
'根据排位和标准定等级:A(10%) B(20%) C(30%) D(30%) E(10%)
If .Cells(i, b) >= (a - 2) * 0.9 Then
.Cells(i, b) = "E"
ElseIf .Cells(i, b) >= (a - 2) * 0.6 Then .Cells(i, b) = "D"
ElseIf .Cells(i, b) >= (a - 2) * 0.3 Then .Cells(i, b) = "C"
ElseIf .Cells(i, b) >= (a - 2) * 0.1 Then .Cells(i, b) = "B"
Else: .Cells(i, b) = "A"
End If
'以下是复制姓名和标题行
.Cells(1, b) = .Cells(1, 1)
.Cells(2, b) = .Cells(2, b - 12) & "末"
.Cells(i, 14) = .Cells(i, 2)
Next i 'for i要在end if 后在for b中间
i = 0
Next b
End With
写的代码运行慢,请教高手提供更合理方案
|
|