选择排序在 Excel 上无法按预期工作

Question

我只需要对我在一个 Excel 数据表中所做的选择进行排序。这本书是共享的，我尽量不避免用户使用过滤/排序选项来使用这个小程序。

我只是尝试了很多方法来解决它：通过宏记录、我自己、谷歌搜索和以任何可能的方式记录。

输入：在一张带有标题的 Excel 工作表中可以进行任何选择。

预期输出：选择的字母排序。

试用一：宏录制

Option Explicit  

Sub Macro1()

    ActiveWorkbook.Worksheets("Raw Data").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Raw Data").Sort.SortFields.Add Key:=Range( _
        "IV71"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Raw Data").Sort
        .SetRange Range("IV72:IZ78")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

该代码有效，但很明显，我需要自定义我的选择：

Option Explicit  

Sub Macro1()
Dim MyRange as Range
Set MyRange = Selection

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

在那一个上，我在 .Apply 上收到 1004 错误。所以我修改为：

Option Explicit  

Sub Macro1()
Dim MyRange as Range
Set MyRange = Selection

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

同样的结果：我在 .Apply 上遇到 1004 错误

然后我删除范围声明：

Option Explicit  

Sub Macro1()

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

它变得很奇怪......无论我尝试并检查过什么选项，它都会报告错误 1004，它直接不起作用，或者它报告定义的部分不能为空白（当它不是空白时）。 Idea 1Idea 2Idea 3Idea 4Idea 5Idea 6Check 1Check 2Check 3Check 4

我唯一担心的是，也许，因为 Selection 是一个对象，也许，将其设置为范围会失败。

一个额外的细节...当我选择一列时，此过程才有效...问题是当我选择 2 或更多时。

谁能帮帮我？

Answer 1

我找到了一个解决方案，无论如何，我仍然不知道为什么我会遇到这个问题。 如果我不单独拆分列，我不能在一个范围内订购许多列。 这不是最好的，但可以工作......也许需要一些清洁。

Option Explicit  

Sub Macro1()

Dim MyRange As Range
Dim FirstCol As Long
Dim LastCol As Long
Dim FirstRow As Long
Dim LastRow As Long
Dim SelAddress As String
Dim Aux As String

Set MyRange = Selection
SelAddress = Selection.Address

SelAddress = Mid(SelAddress, 2, Len(SelAddress) - InStr(1, SelAddress, "$", vbBinaryCompare))
Aux = Mid(SelAddress, 1, InStr(1, SelAddress, "$", vbBinaryCompare) - 1)
SelAddress = Mid(SelAddress, Len(Aux) + 2, Len(SelAddress) - Len(Aux))
Aux = Aux & Mid(SelAddress, 1, InStr(1, SelAddress, "$", vbBinaryCompare) - 2)

FirstCol = Range(Aux).Column
FirstRow = Range(Aux).Row

SelAddress = Mid(Selection.Address, Len(Aux) + 5, Len(SelAddress) - Len(Aux))
Aux = Mid(SelAddress, 1, InStr(1, SelAddress, "$", vbBinaryCompare) - 1)
SelAddress = Mid(SelAddress, Len(Aux) + 2, Len(SelAddress) - Len(Aux))
Aux = Aux & Mid(SelAddress, InStr(1, SelAddress, "$", vbBinaryCompare) + 1, Len(SelAddress))

LastCol = Range(Aux).Column
LastRow = Range(Aux).Row


For i = FirstCol To LastCol Step 1
    Set MyRange = ActiveWorkbook.Worksheets("Raw Data").Range(Cells(FirstRow, i), Cells(LastRow, i))
    ActiveWorkbook.Worksheets("Raw Data").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Raw Data").Sort.SortFields.Add Key:=MyRange, _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Raw Data").Sort
        .SetRange MyRange
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
Next


End Sub

希望对你有帮助！