VBA按用户范围选择排序

时间:2018-01-23 09:20:35

标签: excel vba excel-vba

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

我想要做的是当我运行一个macro1时(为了参数):

  1. 将弹出窗口以选择应对哪些单元格进行排序
  2. 通过选择的最后一列(或第5列)(从最低到最高的数字)
  3. 对这些进行排序

    这里的问题是所选区域会改变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
    

3 个答案:

答案 0 :(得分: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

您也可以通过取ActiveWorkbook.Worksheets的{​​{1}}来整理Parent

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

这里是整个代码:

On Error..

答案 1 :(得分:0)

尝试将您排序的范围(I11:I15)作为单独的变量。为此,您需要intital范围的最后一列及其最后一行。

在下面的代码中,您排序的范围是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

答案 2 :(得分:0)

从记录的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

P.S。如果要执行VBA Sort命令,则应该知道是否有标题行。

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

enter image description here

sub执行完毕后。

enter image description here