写的代码运行慢，请教高手提供更合理方案

hjhjxb

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

写的代码运行慢，请教高手提供更合理方案