VBA宏报错修复求助：批量设置ID及B列排序转文本需求

需求说明 #

我需要实现以下Excel操作：

• 将A3及以下所有单元格的值改为"ID"；
• 对B3及以下单元格进行A到Z排序，并通过文本分列将日期格式转为文本格式。

录制宏生成了如下代码，但无法适配所有数据，请求修复：

Sub Sort2()
'
' Sort2 Macro
'
'
    ActiveCell.FormulaR1C1 = "ID"
    Range("A3").Select
    Selection.Copy
    Range("A3:A30").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlUp)).Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=-135
    Range("B3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    ActiveWorkbook.Worksheets("Tickets Received").ListObjects("Tickets").Sort. _
        SortFields.Clear
    ActiveWorkbook.Worksheets("Tickets Received").ListObjects("Tickets").Sort. _
        SortFields.Add2 Key:=Range("B3:B126"), SortOn:=xlSortOnValues, Order:= _
        xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Tickets Received").ListObjects("Tickets").Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Selection.TextToColumns Destination:=Range("B3"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 2), TrailingMinusNumbers:=True
    Range("C7").Select
End Sub

原代码的问题 #

录制的宏存在以下缺陷，导致无法适配任意数据量：

• 依赖Select和ActiveCell操作，易因选中位置变化触发错误；
• 硬编码固定单元格范围（如Range("B3:B126")），数据行数变化时失效；
• 重复的End(xlDown)/End(xlUp)操作逻辑混乱，无法准确选中全部有效数据；
• 排序绑定了特定列表对象，扩展性差。

修复后的代码 #

Sub SortAndFormat()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim targetRange As Range
    
    ' 指定目标工作表，避免依赖激活的工作表
    Set ws = ThisWorkbook.Worksheets("Tickets Received")
    
    ' 1. 将A3及以下所有单元格设为"ID"
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    If lastRow >= 3 Then
        ws.Range("A3:A" & lastRow).Value = "ID"
    End If
    
    ' 2. 处理B列：排序+文本分列转格式
    lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
    If lastRow >= 3 Then
        Set targetRange = ws.Range("B3:B" & lastRow)
        
        ' 对B列数据进行A-Z排序
        With ws.Sort
            .SortFields.Clear
            .SortFields.Add Key:=targetRange, SortOn:=xlSortOnValues, _
                            Order:=xlAscending, DataOption:=xlSortNormal
            .SetRange ws.Range("B2:B" & lastRow) ' 包含表头（B2）
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
        
        ' 文本分列将日期转为文本格式
        targetRange.TextToColumns Destination:=targetRange, _
                                DataType:=xlDelimited, _
                                TextQualifier:=xlDoubleQuote, _
                                ConsecutiveDelimiter:=False, _
                                Tab:=True, Semicolon:=False, Comma:=False, _
                                Space:=False, Other:=False, _
                                FieldInfo:=Array(1, 2), _
                                TrailingMinusNumbers:=True
    End If
End Sub

代码说明 #

• 明确指定工作表：用Set ws = ThisWorkbook.Worksheets("Tickets Received")锁定目标工作表，避免因激活其他工作表导致错误；
• 动态获取数据范围：通过ws.Cells(ws.Rows.Count, 列名).End(xlUp).Row自动获取列中最后一行数据，适配任意数据量；
• 高效批量赋值：直接使用Range.Value批量设置"ID"，替代低效的复制粘贴操作；
• 动态排序范围：排序时包含表头（B2），确保排序逻辑正确，范围随数据量自动调整；
• 文本分列优化：使用动态获取的targetRange作为操作对象，避免硬编码固定范围。

内容的提问来源于stack exchange，提问作者Evelyne Tandoyo