VBA宏中xlDown始终停在第166行的问题求助

问题背景 #

需要从大数据集中生成精简列表，通过宏删除无用列后将剩余内容格式化为表格，并按Start Date列（E列）降序排序。原代码首次运行正常，但后续执行时从A4向下选择数据始终停在第166行，无法选中后续数据，数据中无空单元格，提前排序也无法解决该问题。

原代码：

'Format to grey scale table and sort by start date (E column) last to first

Range("A4").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Application.CutCopyMode = False
ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$4:$I$166"), , xlYes).Name = _
    "Table1"
Range("Table1[#All]").Select
ActiveSheet.ListObjects("Table1").TableStyle = "TableStyleMedium4"

ActiveWorkbook.Worksheets("Crew Payroll Bible").ListObjects("Table1").Sort. _
    SortFields.Clear
ActiveWorkbook.Worksheets("Crew Payroll Bible").ListObjects("Table1").Sort. _
    SortFields.Add2 Key:=Range("Table1[[#All],[Start Date]]"), SortOn:= _
    xlSortOnValues, Order:=xlDescending, DataOption:=xlSortTextAsNumbers
With ActiveWorkbook.Worksheets("Crew Payroll Bible").ListObjects("Table1").Sort
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With

问题原因 #

原代码中Range("$A$4:$I$166")是硬编码的固定范围，无论实际数据有多少行，都会被限制在166行；同时使用Select方法依赖活动单元格，容易因操作环境变化导致选择范围异常。

修正后的代码 #

'Format to grey scale table and sort by start date (E column) last to first
Dim ws As Worksheet
Dim dataRange As Range
Dim tbl As ListObject

'指定目标工作表，避免依赖ActiveSheet
Set ws = ThisWorkbook.Worksheets("Crew Payroll Bible")

'自动获取A4开始的完整数据区域（假设A列无空行，可准确识别数据边界）
Set dataRange = ws.Range("A4").CurrentRegion

'删除已存在的同名表格，防止重复创建报错
On Error Resume Next
ws.ListObjects("Table1").Delete
On Error GoTo 0

'创建表格并设置样式
Set tbl = ws.ListObjects.Add(xlSrcRange, dataRange, , xlYes)
tbl.Name = "Table1"
tbl.TableStyle = "TableStyleMedium4"

'按Start Date列降序排序
With tbl.Sort
    .SortFields.Clear
    .SortFields.Add2 Key:=tbl.ListColumns("Start Date").Range, _
                     SortOn:=xlSortOnValues, _
                     Order:=xlDescending, _
                     DataOption:=xlSortTextAsNumbers
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With

关键改进点 #

• 移除Select方法，直接通过对象操作数据，提升代码稳定性和执行效率
• 使用CurrentRegion自动识别完整数据范围，替代硬编码的固定行号，适配数据行数变化
• 增加同名表格的删除逻辑，避免重复创建时的运行时错误
• 直接引用表格的列对象，而非单元格地址，提升代码可读性和维护性

内容的提问来源于stack exchange，提问作者Charles Sullivan