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

【问题标题】：Last column sorting for multiple fixed rows through VBA通过VBA对多个固定行进行最后一列排序
【发布时间】：2021-12-07 03:15:57
【问题描述】：

尝试修复宏以在每张工作表的最后一列进行排序，但行是固定的 A3:A20 和 A23:A32。找到下面的代码，但我无法锁定其中的行。无法破解如何在下面的代码中定义行。 sample data

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

【问题讨论】：

“固定行”是什么意思？
抱歉 - 如果您分享数据的屏幕截图可能会有意义 - 我不明白“行固定在 A3:A20 和 A22:A32”是什么意思。
您的意思是要从排序中排除第 3-20 行和第 22-32 行？
嗨@TAB。欢迎来到 StackOverflow。我建议您花更多时间在谷歌上搜索以了解您找到的代码所做的一些事情。那么也许你会明白如何改变它。如果您努力更改代码以满足您的要求并且无法使其工作 - 继续谷歌搜索。最后，如果您在任何地方都找不到答案，请在此处写一个问题，详细说明您的尝试，我们将解释为什么这不起作用以及如何解决它。这就是 SO 的工作原理。
@CDP1802 根据最后一列在第 3:20 行和第 23:32 行进行排序，已附上数据图像

标签： excel vba sorting

【解决方案1】：

对多个范围进行排序

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

【讨论】：

【解决方案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

【讨论】：