20171104xlVBA各人各科进退

Sub 各班个人各科进步幅度()

    Dim dRank As Object

    Set dRank = CreateObject("Scripting.Dictionary")

    Dim dStd As Object

    Set dStd = CreateObject("Scripting.Dictionary")

    Dim dSbj As Object

    Set dSbj = CreateObject("Scripting.Dictionary")

    em = Array("月考2", "期中考")

    For n = LBound(em) To UBound(em) Step 1

        Set sht = ThisWorkbook.Worksheets("成绩表_" & em(n))

        With sht

            EndRow = .Cells(.Cells.Rows.Count, 1).End(xlUp).Row

            EndCol = .Cells(1, .Cells.Columns.Count).End(xlToLeft).Column

            For i = 2 To EndRow

                Key = CStr(.Cells(i, 1).Value)

                dStd(Key) = Array(CStr(.Cells(i, 1).Value), CStr(.Cells(i, 2).Text), CStr(.Cells(i, 3).Text))

                For J = 1 To EndCol

                    If .Cells(1, J).Text Like "*排" Then

                        dSbj(.Cells(1, J).Text) = ""

                    End If

                    Key = CStr(.Cells(i, 1).Value) & ";" & em(n) & .Cells(1, J).Text

                    'Debug.Print Key

                    dRank(Key) = .Cells(i, J).Value

                Next J

            Next i

        End With

    Next n

    For Each K In dSbj.Keys

        Set sht = CreateSheet(ThisWorkbook, K & "_飞跃进步_我^_^了")

        With sht

            .Range("a1").Resize(1, 6).Value = Array("考号", "姓名", "班级", em(0), em(1), "进退")

            EndCol = .Cells(1, .Cells.Columns.Count).End(xlToLeft).Column

            i = 1

            For Each std In dStd.Keys

                i = i + 1

                Ar = dStd(std)

                .Cells(i, 1).Value = Ar(0)

                .Cells(i, 2).Value = Ar(1)

                .Cells(i, 3).Value = Ar(2)

                Key = CStr(Ar(0)) & ";" & .Cells(1, 4).Text & Split(.Name, "_")(0)

                .Cells(i, 4).Value = dRank(Key)

                Key = CStr(Ar(0)) & ";" & .Cells(1, 5).Text & Split(.Name, "_")(0)

                .Cells(i, 5).Value = dRank(Key)

                .Cells(i, 6) = Val(.Cells(i, 4).Value) - Val(.Cells(i, 5).Value)

            Next std

            Sort_Rank .UsedRange, True

            .Columns.AutoFit

        End With

    Next K

    Set dSbj = Nothing

    Set dStd = Nothing

    Set dRank = Nothing

End Sub

Public Sub Sort_ClassRank(ByVal Rng As Range, Optional WithHeader As Boolean = True)

    With Rng

        .Sort _

            Key1:=Rng.Cells(1, 3), Order1:=xlAscending, _

            Key2:=Rng.Cells(1, 6), Order2:=xlDescending, _

            Header:=IIf(WithHeader, xlYes, xlNo), MatchCase:=False, Orientation:=xlTopToBottom, SortMethod:=xlPinYin

    End With

End Sub

Public Sub Sort_Rank(ByVal Rng As Range, Optional WithHeader As Boolean = True)

    With Rng

        .Sort _

            Key1:=Rng.Cells(1, 6), Order1:=xlDescending, _

            Header:=IIf(WithHeader, xlYes, xlNo), MatchCase:=False, Orientation:=xlTopToBottom, SortMethod:=xlPinYin

    End With

End Sub