Macro to sort data until blank row(s), then repeat

2019-07-27 11:20发布

问题:

In column A I have a list of players names, in column B I have their scores. there are a varying number of players followed by an unset number of blank rows, followed by another list of players.

I need a macro in vba that will sort columns A and B in descending order based on the player's score (column B), but only until it hits the blank row(s). Then once it hits the blank row(s) it will jump to the next set of players and sort them in the same way, continuing in a loop until all the data is sorted.

Code from comments:

Dim N As Long
N = Cells(1, 1).End(xlDown).Row
Range("A1:B" & N).Sort Key1:=Range("B1:B" & N), Order1:=xlDescending, Header:=xlGuess

Update from comments:

Two sequential sorts should be performed on each group. F:G with G:G being the primary key then H:I with I:I being the primary key.

回答1:

Try to avoid Range .Select¹ method when referencing the cells on the worksheet. Tracking the position through variables and using these for direct referencing is the preferred method.

Sub playersort()
    Dim i As Long, rw As Long
    rw = 1
    With Worksheets("Players_Scores")
        Do While rw < .Cells(Rows.Count, "A").End(xlUp).Row
            With .Cells(rw, 6).CurrentRegion
                With .Resize(.Rows.Count, 2)
                    .Cells.Sort Key1:=.Columns(2), Order1:=xlDescending, _
                                Key2:=.Columns(1), Order2:=xlAscending, _
                                Orientation:=xlTopToBottom, Header:=xlYes   '<~~ you should know if you have a header or not!
                End With
                With .Resize(.Rows.Count, 2).Offset(0, 2)
                    .Cells.Sort Key1:=.Columns(2), Order1:=xlDescending, _
                                Key2:=.Columns(1), Order2:=xlAscending, _
                                Orientation:=xlTopToBottom, Header:=xlYes   '<~~ you should know if you have a header or not!
                End With
            End With
            For i = 1 To 2
                rw = .Cells(rw, 1).End(xlDown).Row
            Next i
        Loop
    End With
End Sub

By keeping the rw var updated, shifting down twice to skip the blank rows is a simple matter.

You really should know if your data has a column header label row or not. The xlGuess may work for recorded code most of the time but it simply isn't reliable.


¹ See How to avoid using Select in Excel VBA macros for more methods on getting away from relying on select and activate to accomplish your goals.