求助编写仅对当前工作表执行两种自定义排序的VBA代码

以下是两个通用VBA宏，可在包含31个受保护工作表的工作簿中，仅对当前活动工作表执行指定排序，排序后自动恢复保护状态：

1. 数字升序排序宏（按A列） #

这个宏是你录制的OccSort的通用版本，针对当前操作表的A2:F502区域按A列数字升序排序：

Sub NumberAscSort()
    ' 可自行设置快捷键（比如Ctrl+O）
    Dim ws As Worksheet
    Set ws = ActiveSheet ' 指向当前操作的工作表
    
    ' 取消工作表保护
    ws.Unprotect
    
    ' 清除原有排序规则
    ws.Sort.SortFields.Clear
    
    ' 添加A列升序排序规则
    ws.Sort.SortFields.Add2 Key:=ws.Range("A2:A502"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    
    ' 执行排序
    With ws.Sort
        .SetRange ws.Range("A2:F502")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    ' 恢复工作表保护，保留允许排序权限
    ws.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowSorting:=True
    
    ' 可选：定位到G2单元格（和你录制的宏逻辑一致）
    ws.Range("G2").Select
End Sub

2. 自定义顺序排序宏（standard→medium→high） #

这个宏针对指定列（示例为B列，可自行修改）按standard→medium→high的自定义顺序排序：

Sub CustomPrioritySort()
    ' 可自行设置快捷键（比如Ctrl+M）
    Dim ws As Worksheet
    Set ws = ActiveSheet
    
    ' 取消工作表保护
    ws.Unprotect
    
    ' 清除原有排序规则
    ws.Sort.SortFields.Clear
    
    ' 添加自定义排序规则
    ws.Sort.SortFields.Add2 Key:=ws.Range("B2:B502"), _ ' 修改为你要排序的列范围
        SortOn:=xlSortOnValues, Order:=xlAscending, _
        CustomOrder:="standard,medium,high", DataOption:=xlSortNormal
    
    ' 执行排序
    With ws.Sort
        .SetRange ws.Range("A2:F502") ' 排序的整个数据区域
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    ' 恢复工作表保护，保留允许排序权限
    ws.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowSorting:=True
    
    ' 可选：定位到G2单元格
    ws.Range("G2").Select
End Sub

关键改进说明 #

• 用ActiveSheet替代硬编码的工作表名称，实现对当前操作表的通用处理，无需为每个工作表单独录制宏
• 提取工作表对象变量ws，避免重复调用ActiveSheet，代码更高效清晰
• 保留保护状态切换逻辑，确保排序能正常执行，同时排序后恢复保护并保留允许排序的权限

设置快捷键 #

1. 打开VBA编辑器（Alt+F11）
2. 在左侧工程窗口找到对应宏，右键选择「选项」
3. 在「快捷键」栏设置所需组合键（比如给NumberAscSort设Ctrl+O，CustomPrioritySort设Ctrl+M）

内容的提问来源于stack exchange，提问作者Katrina Farrell Richardson