通过VBA对多个固定行进行最后一列排序

Question

试图修复在每个表的最后一列上排序的宏，但行是固定的A3:A20 &A23: A32。发现下面的代码，但我无法锁定行在它。无法破解如何定义下面代码中的行。样本数据

Sub jusho()    
Dim lColumn As Long
lColumn = Cells(1, Columns.Count).End(xlToLeft).Column
LastRow = Range("A" & Rows.Count).End(xlUp).Row

Range(Cells(2, 1), Cells(LastRow, lColumn)).Sort key1:=Range(Cells(2, lColumn), Cells(LastRow, lColumn)), _
order1:=xlAscending, Header:=xlNo
End Sub

Answer 1

Sort Multiple range

Option Explicit
Sub SortByLastColumnASC()
SortMultipleRanges ThisWorkbook, "Sheet1", "2:20,22:32"
End Sub
Sub SortByLastColumnDSC()
SortMultipleRanges ThisWorkbook, "Sheet1", "2:20,22:32", , xlDescending
End Sub
Sub SortBySalesKeyASC()
SortMultipleRanges ThisWorkbook, "Sheet1", "2:20,22:32", 1
End Sub
Sub SortByDateKeyASC()
SortMultipleRanges ThisWorkbook, "Sheet1", "2:20,22:32", 2
End Sub
Sub SortMultipleRanges( _
ByVal wb As Workbook, _
ByVal wsName As String, _
ByVal wsRowsList As String, _
Optional ByVal SortColumn As Long = 0, _
Optional ByVal SortOrder As XlSortOrder = xlAscending, _
Optional ByVal SortHeader As XlYesNoGuess = xlYes)
Const ProcName As String = "SortMultipleRanges"
On Error GoTo ClearError
Dim ws As Worksheet: Set ws = wb.Worksheets(wsName)
Dim srg As Range: Set srg = ws.Range("A1").CurrentRegion

If SortColumn = 0 Then
SortColumn = srg.Columns.Count
End If

Dim wsRows() As String: wsRows = Split(wsRowsList, ",")
Dim nUpper As Long: nUpper = UBound(wsRows)

Dim drg As Range
Dim n As Long

For n = 0 To nUpper
Set drg = srg.Rows(wsRows(n))
drg.Sort Key1:=drg.Columns(SortColumn), Order1:=SortOrder, _
Header:=SortHeader
Next n

ProcExit:
Exit Sub
ClearError:
Debug.Print "'" & ProcName & "': Unexpected Error!" & vbLf _
& "    " & "Run-time error '" & Err.Number & "':" & vbLf _
& "    " & Err.Description
Resume ProcExit
End Sub

Answer 2

考虑使用宏来查找排序范围的开始行和结束行，而不是将它们硬编码。

Option Explicit
Sub SortRows()
Dim wb As Workbook, ws As Worksheet
Dim LastCol As Long, LastRow As Long, r As Long, n As Long
Dim rowStart As Long, rng As Range, s As String
Set wb = ThisWorkbook
Set ws = wb.Sheets("Sheet1")
With ws
LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
LastCol = .Cells(1, Columns.Count).End(xlToLeft).Column
For r = 2 To LastRow
' start sort range
If .Cells(r, "A") = "SalesKey" Then
If rowStart > 0 Then
MsgBox "Duplicate SalesKey on row " & r, vbExclamation
End If
rowStart = r + 1
' end sort range
ElseIf .Cells(r, "A") = "Total" Then
If rowStart = 0 Then
MsgBox "Total without records on row " & r, vbExclamation
ElseIf r > rowStart + 1 Then
Set rng = .Cells(rowStart, 1).Resize(r - rowStart, LastCol)
rng.Sort key1:=.Cells(r, LastCol),  _
order1:=xlAscending, Header:=xlNo
s = s & vbCrLf & rng.Address
End If
rowStart = 0
End If
Next
End With
MsgBox "Sorted ranges : " & s, vbInformation
End Sub