VBA Sort by selected by user range

问题

I've been struggling with this issue in the past 3 days, so please help...

What I want to do is to when I run a macro1 (for the sake of the argument):

Window would pop up to select a range of which cells should be sorted
Have these sorted via last column selected (or the 5th) (lowest to highest numbers)

The issue here is that selected area would change eveytime (I create something like a tree in excel), so it cannot be a specific column that needs to be sorted by the last one (or the 5th in this case) of the selected (in the code below I do not know how to change I11:I15)

What I got and it does not work:

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

回答1:

You can get the end column of rngStart as a Range with:

rngStart.Columns(rngStart.Columns.Count)

Using a With to tidy this up, you could do the following:

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

You could also tidy up the ActiveWorkbook.Worksheets by instead taking the Parent of rngStart.

Lastly, you want to trap the error that would occur if the user clicks Cancel instead of selecting a range. There are a number of ways of doing this but the first one that came to mind was using an On Error.. trap.

Here's the whole code:

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

回答2:

Try to get the range on which you sort (I11:I15) as a separate variable. In order to do this, you need the last column of your intital range and the last row of it.

In the code below, the range you sort is rngSort and it is defined through

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

To get the last column and the last row, you need:

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

Once you are ready with the rngSort then you simply change the I11:I15 part in your code with it:

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

回答3:

Go back a step from the recorded VBA sort to what is actually required and use transpose to change your inputbox range to a one dimensioned array.

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

p.s. If you are going to execute a VBA Sort command, you should know whether you have a header row or not.

Before sub procedure with local E2:E9 selected.

After sub has executed.

来源：https://stackoverflow.com/questions/48398081/vba-sort-by-selected-by-user-range

标签

excel

vba