如何用Excel VBA对选中的非空白连续单元格按规则排序？

需求背景与问题 #

本人使用Excel管理金属熔炼配合金工作，现有宏功能如下：

• New_macro至New_macro5：为选中行设置指定颜色标记熔炼用料（黄、蓝、绿、紫、深蓝）
• New_macro6：清除选中单元格颜色并清空数据

当前存在的问题：

• 原生自定义排序会丢失用户输入
• 现有ColourSort宏仅支持单列排序，无法实现整行同步移动

需要实现的排序逻辑：

1. 优先按颜色顺序排序：黄（RGB(255,192,0)）→蓝（RGB(0,176,240)）→绿（RGB(146,208,80)）→紫（RGB(122,48,160)）→深蓝（RGB(0,112,192)）
2. 颜色排序后，按标识列单元格值升序排序
3. 整行数据随标识列同步移动
4. 排序时自动避开底部统计行

请问是否可利用Immediate窗口的Selection.Address功能实现上述需求？

现有VBA代码 #

Sub New_macro()
        Dim myRange As Range
        Set myRange = Selection
     Selection.Interior.Color = RGB(255, 192, 0)
End Sub
Sub New_macro2()
        Dim myRange As Range
        Set myRange = Selection
     Selection.Interior.Color = RGB(0, 176, 240)
End Sub
Sub New_macro3()
        Dim myRange As Range
        Set myRange = Selection
      Selection.Interior.Color = RGB(146, 208, 80)
End Sub
Sub New_macro4()
        Dim myRange As Range
        Set myRange = Selection
     Selection.Interior.Color = RGB(122, 48, 160)
End Sub
Sub New_macro5()
        Dim myRange As Range
        Set myRange = Selection
     Selection.Interior.Color = RGB(0, 112, 192)
End Sub
Sub New_macro6()
    Dim myRange As Range
         Set myRange = Selection
     Selection.Interior.ColorIndex = xlNone
     Selection.Clear
End Sub
Sub ColourSort()
    Dim myRange As Range
    Set myRange = Selection
    myRange.Select
        ActiveWorkbook.ActiveSheet.Sort.SortFields.Clear
        ActiveWorkbook.ActiveSheet.Sort.SortFields.Add(Selection, _
            xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255, _
            192, 0)
        ActiveWorkbook.ActiveSheet.Sort.SortFields.Add(Selection, _
            xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(0, 176 _
            , 240)
        ActiveWorkbook.ActiveSheet.Sort.SortFields.Add(Selection, _
            xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(146, _
            208, 80)
        ActiveWorkbook.ActiveSheet.Sort.SortFields.Add(Selection, _
            xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(122, 48 _
            , 160)
        ActiveWorkbook.ActiveSheet.Sort.SortFields.Add(Selection, _
            xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(0, 112 _
            , 192)
        ActiveWorkbook.ActiveSheet.Sort.SortFields.Add2 Key:=Selection() _
            , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        With ActiveWorkbook.ActiveSheet.Sort
                .SetRange Selection
                .Header = xlGuess
                .MatchCase = False
                .Orientation = xlTopToBottom
                .SortMethod = xlPinYin
                .Apply
            End With
        End Sub

解决方案：利用Selection.Address实现需求 #

可以通过Selection.Address实现目标，核心是用它获取选中标识列的地址，进而定位到需要排序的整行数据区域（排除底部统计行），再设置正确的排序规则。

修改后的ColourSort宏代码 #

Sub ColourSort()
    Dim targetCol As Range
    Dim sortRange As Range
    Dim lastDataRow As Long
    
    ' 获取选中的标识列（通过Selection.Address转换为Range）
    Set targetCol = Range(Selection.Address)
    
    ' 找到标识列最后一个非空单元格的上一行（避开底部统计行）
    lastDataRow = targetCol.Cells(targetCol.Rows.Count, 1).End(xlUp).Row - 1
    
    ' 定义排序范围：从表头行（假设第1行是表头）到lastDataRow的整行数据
    Set sortRange = Range("1:" & lastDataRow)
    
    ' 清除原有排序规则
    ActiveSheet.Sort.SortFields.Clear
    
    ' 添加颜色排序规则（按指定顺序）
    With ActiveSheet.Sort.SortFields
        .Add Key:=targetCol, SortOn:=xlSortOnCellColor, Order:=xlAscending, _
             SortOnValue:=RGB(255, 192, 0)
        .Add Key:=targetCol, SortOn:=xlSortOnCellColor, Order:=xlAscending, _
             SortOnValue:=RGB(0, 176, 240)
        .Add Key:=targetCol, SortOn:=xlSortOnCellColor, Order:=xlAscending, _
             SortOnValue:=RGB(146, 208, 80)
        .Add Key:=targetCol, SortOn:=xlSortOnCellColor, Order:=xlAscending, _
             SortOnValue:=RGB(122, 48, 160)
        .Add Key:=targetCol, SortOn:=xlSortOnCellColor, Order:=xlAscending, _
             SortOnValue:=RGB(0, 112, 192)
        ' 添加标识列值排序规则
        .Add2 Key:=targetCol, SortOn:=xlSortOnValues, Order:=xlAscending, _
              DataOption:=xlSortNormal
    End With
    
    ' 应用排序设置
    With ActiveSheet.Sort
        .SetRange sortRange
        .Header = xlYes ' 明确表头存在，避免误排序表头
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

关键说明 #

1. Selection.Address的作用：将用户选中的标识列地址转换为Range对象，以此为基准扩展排序范围。
2. 排除统计行：通过End(xlUp)找到标识列最后一个非空单元格，再减1跳过底部统计行。
3. 整行排序：将排序范围设置为Range("1:" & lastDataRow)，确保整行数据随标识列同步移动。
4. 明确表头设置：将Header设为xlYes，避免表头被参与排序，防止数据混乱。

内容的提问来源于stack exchange，提问作者Christopher Costabile