VBA 按用户范围选择排序

Question

过去 3 天我一直在努力解决这个问题，所以请帮助...

我想要做的是当我运行一个宏1时（为了论证）：

1. 将弹出窗口以选择应排序的单元格范围
2. 按照选择的最后一列（或第 5 列）（从最低到最高的数字）对这些进行排序

这里的问题是所选区域会改变 eveytime（我在 excel 中创建了类似树的东西），因此它不能是需要按最后一个（或本例中的第 5 个）排序的特定列选中（在下面的代码中我不知道如何更改 I11:I15）

我得到了什么，但它不起作用：

Sub RangeSelectionPrompt()
    Dim rngStart As Range
    Set rngStart = Application.InputBox("Select a range", "Obtain Range Object", Type:=8)

    Set rngStart = Selection

    rngStart.Select
    ActiveWorkbook.Worksheets("CALCULATION").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("CALCULATION").Sort.SortFields.Add Key:=Range( _
        "I11:I15"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("CALCULATION").Sort
        .SetRange rngStart
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

Answer 1

您可以将rngStart 的结尾列作为范围获取：

rngStart.Columns(rngStart.Columns.Count)

使用With 整理一下，您可以执行以下操作：

With rngStart
    ActiveWorkbook.Worksheets("CALCULATION").Sort.SortFields.Add Key:= _
        .Columns(.Columns.Count), SortOn:=xlSortOnValues, Order:= _
        xlAscending, DataOption:=xlSortNormal
End With

您也可以通过使用Parent 或rngStart 来整理ActiveWorkbook.Worksheets。

最后，如果用户单击取消而不是选择范围，您希望捕获可能发生的错误。有很多方法可以做到这一点，但首先想到的是使用On Error.. 陷阱。

这是整个代码：

Sub RangeSelectionPrompt()

    Dim rngStart As Range
    Dim WS As Worksheet

    On Error Resume Next
    Set rngStart = Application.InputBox("Select a range", "Obtain Range Object", Type:=8)
    Err.Clear
    On Error GoTo 0

    If rngStart Is Nothing Then
        MsgBox "User cancelled"
    Else
        Set WS = rngStart.Parent
        WS.Sort.SortFields.Clear

        With rngStart
            WS.Sort.SortFields.Add Key:= _
                .Columns(.Columns.Count), SortOn:=xlSortOnValues, Order:= _
                xlAscending, DataOption:=xlSortNormal
        End With

        With WS.Sort
            .SetRange rngStart
            .Header = xlGuess
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
    End If
End Sub

Answer 2

尝试将您排序的范围 (I11:I15) 作为单独的变量。为此，您需要初始范围的最后一列和它的最后一行。

在下面的代码中，你排序的范围是rngSort，它是通过

定义的

Set rngSort = .Parent.Range(.Parent.Cells(firstRow, lastCol), _
                            .Parent.Cells(lastRow, lastCol))

要获取最后一列和最后一行，你需要：

lastCol = .Cells(.Count).Column
lastRow = .Rows(.Rows.Count).Row

一旦您准备好使用rngSort，您只需使用它更改代码中的I11:I15 部分：

Option Explicit

Sub RangeSelectionPrompt()

    Dim rngStart    As Range
    Dim rngSort     As Range

    Dim lastCol     As Long
    Dim lastRow     As Long
    Dim firstRow    As Long
    Dim firstCol    As Long 'you do not need it

    Set rngStart = Application.InputBox("Select a range", "Obtain Range Object", Type:=8)
    With rngStart
        lastCol = .Cells(.Count).Column
        lastRow = .Rows(.Rows.Count).Row
        firstCol = .Cells(1, 1).Column
        firstRow = .Cells(1, 1).Row
        Set rngSort = .Parent.Range(.Parent.Cells(firstRow, lastCol), _
                                    .Parent.Cells(lastRow, lastCol))
    End With

    ActiveWorkbook.Worksheets("CALCULATION").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("CALCULATION").Sort.SortFields.Add Key:=rngSort, _
    SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("CALCULATION").Sort
        .SetRange rngStart
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

Answer 3

从记录的 VBA 排序返回到实际需要的排序，并使用转置将输入框范围更改为一维数组。

Dim vCustom_Sort As Variant, rr As Long, rng As Range

Set rng = Application.InputBox("Select a range", "Obtain Range Object", Default:=Selection.Address, Type:=8)

vCustom_Sort = Application.Transpose(rng)
Application.AddCustomList ListArray:=vCustom_Sort

With Worksheets("Sheet4")    '<~~ set this properly!
    .Sort.SortFields.Clear
    rr = .Cells(.Rows.count, "A").End(xlUp).Row
    With .Range("A1:A" & rr)
        .Cells.Sort Key1:=.Columns(1), Order1:=xlAscending, _
                    Orientation:=xlTopToBottom, Header:=xlYes, MatchCase:=False, _
                    OrderCustom:=Application.CustomListCount + 1

    End With
    .Sort.SortFields.Clear
End With

附言如果你要执行 VBA 排序命令，你应该知道你是否有标题行。

在选择本地 E2:E9 的子程序之前。

sub 执行后。