关于补考学生统计

共有两个大问题需要解决：①如何按百分比提取需要补考学生名单；②如何把两次同科需要的学生改为只需补考一次即可。

第1个问题已经解决，充分利用Application.WorksheetFunction.Percentile(Range(Cells(2, 5), Cells(totalR, 5)), 1 - (50 + (i - 1) * 50) / totalR)就可以解决。

现在主要是想来解决第2个问题：

以第5学段文科及第6学段文科为例：

原表示意如下：其中图1为第5学段示意图，图2为第6学段示意图。由于不可避免的5、6学段中肯定会有重复的学生。所以现在需要做的就是如何把在第6学段中存在且在第5学段也有，并且具有相同科目需要补考的学生做出标志。

            图1                                                               图2

下面先把需要删掉的重复行做上标志：“重复”字样

Sub 按科合并重复项()
    Dim i As Integer, j As Integer, k As Integer, totalR5 As Integer, totalR6 As Integer
    Dim mycell As Range, myrange As Range
    Worksheets("第5学段文科补考名单").Activate
    totalR5 = Range("A65536").End(xlUp).Row
    For i = 2 To totalR5
        Worksheets("第5学段文科补考名单").Activate
        Set mycell = Range(Cells(i, 2), Cells(i, 2))
        Worksheets("第6学段文科补考名单").Activate
        totalR6 = Range("A65536").End(xlUp).Row
        For Each myrange In Range(Cells(2, 2), Cells(totalR6, 2))
            If mycell.Value = myrange.Value Then
                For j = 1 To 3
                    If (mycell.Offset(0, j).Value <> "" And myrange.Offset(0, j).Value = "") Or (mycell.Offset(0, j).Value <> "" And myrange.Offset(0, j).Value <> "") Then
                        myrange.Offset(0, j).Value = mycell.Offset(0, j).Value
                        mycell.Font.ColorIndex = 3
                        mycell.Offset(0, 4).Value = "重复"
                        If mycell.Offset(0, j).Value <> "" And myrange.Offset(0, j).Value <> "" Then
                            myrange.Offset(0, j).Value = mycell.Offset(0, j).Value
                            mycell.Font.ColorIndex = 3
                            mycell.Offset(0, 4).Value = "重复"
                        End If

                    End If
                Next j
            End If
        Next myrange
    Next i
    Set mycell = Nothing
End Sub
此时效果图如下图所示：

下面需要做的是把带有重复标志的行删掉。

Sub 删除重复行()
    Worksheets("第5学段文科补考名单").Activate
    totalR5 = Range("A65536").End(xlUp).Row
    For i = totalR5 To 2 Step -1
        If Range(Cells(i, 6), Cells(i, 6)).Value = "重复" Then
            Range(Cells(i, 6), Cells(i, 6)).EntireRow.Delete
        End If
    Next i
End Sub

此时效果图如下图所示：

然后把此表余下部分复制到第6学段中即可。

 今天你菊子曰了么？