跪求一段VBA代码？谢谢！

cdhgwz

在多个班级中找学生总分最大值，然后按大到小顺序，放在“全校榜”中，如果7.1两名学生总分相同，学号小的在前，其他班级同前；如果7.1、7.2总分相同，7.1学生放在前面！其他班级类同。再谢谢！！

sword_liu

排序功能使用Recordset来实现相对比较容易，详细代码如下：

Option Explicit
Sub StudentRankByGrades()
    '创建Recordset
    Dim rs As New ADODB.Recordset
    Dim i, j As Integer
    Dim fields
    fields = Array("学号", "班次", "姓名", "语文", "英语", "数学", "总分", "班排名", "校排名")
    '定义字段
    Dim s As Variant
    For Each s In fields
        If s = "姓名" Then
            rs.fields.Append s, adVariant
        Else
            rs.fields.Append s, adInteger
        End If
    Next
    rs.Open

    '将数据插入到Recordset中
    Dim data
    For i = 1 To 4 Step 1
        data = Range(Sheets(i).Cells(5, 1), Sheets(i).Cells(Sheets(i).UsedRange.Rows.Count, 9)).Value
        For j = 1 To UBound(data)
            rs.AddNew fields, Application.Transpose(Application.Transpose(Application.Index(data, j, 0)))
        Next
    Next
    '按照要求排序
    rs.Sort = "总分 DESC, 班次 ASC, 学号 ASC"
    rs.MoveFirst
    '分两栏写入排名前100位的同学
    i = 1
    With Sheets(5)
        While Not rs.EOF
            If i > 100 Then
                MsgBox "已完成前100位学生的排名。"
                Exit Sub
            End If
            For j = 1 To 6 Step 1
                If i > 50 Then
                    .Cells(i - 50 + 2, j + 7) = rs.fields(j).Value
                Else
                    .Cells(i + 2, j) = rs.fields(j).Value
                End If
            Next
            If i > 50 Then
                .Cells(i - 50 + 2, 14) = rs.fields(8)
            Else
                .Cells(i + 2, 7) = rs.fields(8)
            End If
            rs.MoveNext
            i = i + 1
        Wend
    End With
    MsgBox "已完成学生的排名。"
End Sub

sword_liu

使用ADO Recordset实现数据的排序相对比较简单，详细代码如下：---------------------------------------------------------------------------------------------------------------------------------------------

Option Explicit
Sub StudentRankByGrades()
    '创建Recordset
    Dim rs As New ADODB.Recordset
    Dim i, j As Integer
    Dim fields
    fields = Array("学号", "班次", "姓名", "语文", "英语", "数学", "总分", "班排名", "校排名")
    '定义字段
    Dim s As Variant
    For Each s In fields
        If s = "姓名" Then
            rs.fields.Append s, adVariant
        Else
            rs.fields.Append s, adInteger
        End If
    Next
    rs.Open

    '将数据插入到Recordset中
    Dim data
    For i = 1 To 4 Step 1
        data = Range(Sheets(i).Cells(5, 1), Sheets(i).Cells(Sheets(i).UsedRange.Rows.Count, 9)).Value
        For j = 1 To UBound(data)
            rs.AddNew fields, Application.Transpose(Application.Transpose(Application.Index(data, j, 0)))
        Next
    Next
    '按照要求排序
    rs.Sort = "总分 DESC, 班次 ASC, 学号 ASC"
    rs.MoveFirst
    '分两栏写入排名前100位的同学
    i = 1
    With Sheets(5)
        While Not rs.EOF
            If i > 100 Then
                MsgBox "已完成前100位学生的排名。"
                Exit Sub
            End If
            For j = 1 To 6 Step 1
                If i > 50 Then
                    .Cells(i - 50 + 2, j + 7) = rs.fields(j).Value
                Else
                    .Cells(i + 2, j) = rs.fields(j).Value
                End If
            Next
            If i > 50 Then
                .Cells(i - 50 + 2, 14) = rs.fields(8)
            Else
                .Cells(i + 2, 7) = rs.fields(8)
            End If
            rs.MoveNext
            i = i + 1
        Wend
    End With
    MsgBox "已完成学生的排名。"
End Sub