如何根据学生各科及总分成绩划分等第

问题提出的背景：现在实行素质教育后，不允许给学生公布成绩了，只允许以A、B、C、D的形式进行公布，以前都是在VFP中进行，但需要来回的转换格式，很是烦锁，尤其是在转换时，需要一科科的进行数据格式的转换还往往出问题，如果在Excel里就可以直接转换的话，那肯定可以节省很多时间。

问题解决的思路：因为只能有A、B、C、D四个等第，所以可以利用Select Case语句来解决，而且以前最熟悉的是IF语句，现在想知彻底解决条件判断语句的用法。就以这个作为一个例子吧。

首先根据成绩及A、B、C、D四个等第的比例进行等第确认，源程序如下：

Sub 等第确认()
'打开zcj工作表
Dim mycell As Range
Worksheets("zcj").Activate
For i = 1 To 3
For Each mycell In Range(Cells(2, 6 + (i - 1) * 3), Cells(1172, 6 + (i - 1) * 3))
Select Case mycell.Value
Case 1052 To 1171
mycell.Offset(0, 1).Value = "D"
Case 1051 * 0.7 To 1051
mycell.Offset(0, 1).Value = "C"
Case 1051 * 0.3 To 1051 * 0.7
mycell.Offset(0, 1).Value = "B"
Case Else
mycell.Offset(0, 1).Value = "A"
End Select
Next mycell
Next i
ActiveSheet.Copy before:=ActiveSheet
ActiveSheet.Name = "zcj备份"
Worksheets("zcj").Activate
'以下为把所有等第为A、B、C的学生完全删掉，这样只留下等第为D的学生了。
Dim totalR As Integer
totalR = Range("C65536").End(xlUp).Row
For i = totalR To 2 Step -1
If Application.WorksheetFunction.CountIf(Range(Cells(i, 5), Cells(i, 13)), "D") = 0 Then
Range(Cells(i, 1), Cells(i, 1)).EntireRow.Delete
End If
Next i
Range("A1").CurrentRegion.Font.Name = "微软雅黑"
Range("A1").CurrentRegion.Font.Size = 10
End Sub

效果截图如下：





图1 确认完等第后的效果图





图2 把没有D的学生删掉后的效果图

另一方法，源程序如下：

Sub 提取等第为D学生名单()
Dim totalRD As Integer
Dim totalR, i As Integer
Dim mycell As Range
totalRD = 1
Worksheets("等第为D学生名单").Activate
Worksheets("语数外等第公示").Activate
totalR = Range("C65536").End(xlUp).Row
For Each mycell In Range("E2:H1172")
If mycell = "D" Then
mycell.EntireRow.Copy
Worksheets("等第为D学生名单").Activate
totalRD = Range("C65536").End(xlUp).Row
Range(Cells(totalRD + 1, 1), Cells(totalRD + 1, 1)).PasteSpecial xlPasteAll
Application.CutCopyMode = False
Worksheets("语数外等第公示").Activate
End If
Next mycell
'删掉重复值
Worksheets("等第为D学生名单").Activate
totalRD = Range("C65536").End(xlUp).Row
For i = totalRD To 1 Step -1
If Application.WorksheetFunction.CountIf(Range(Cells(1, 2), Cells(totalRD, 2)), Cells(i, 2)) > 1 Then
Range(Cells(i, 2), Cells(i, 2)).EntireRow.Delete
End If
Next i
Range("A1").CurrentRegion.Font.Name = "微软雅黑"
Range("A1").CurrentRegion.Font.Size = 10
End Sub

对比：第2种方法也可以，但显得太麻烦，因为需要做多个工作表，而且会在“等第为D学生名单”中出现多个重复值，不利于数据的严谨性，所以还是第1种方法较科学。



今天你菊子曰了么？