Excel VBA过滤数据后如何实现从1开始的重新编号

修正原宏的语法错误 #

你代码里的Orientation = top-to-bottom存在语法错误，需改为Orientation = xlTopToBottom，否则宏运行会报错。

给Sheet3复制后的区域重新编号 #

完成AdvancedFilter复制操作后，添加一段代码给目标区域的编号列从1开始连续编号。假设编号列是Sheet3的D列（复制区域的第一列），修改后的完整代码如下：

Sheets("Sheet3").Range("C13:N3200").AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=Range("D3:G4"), CopyToRange:=Range("D13:M13"), Unique:= _
        False

' 给Sheet3中复制的数据重新编号（D列为编号列，从D14开始）
Dim lastRowSheet3 As Long
lastRowSheet3 = Sheets("Sheet3").Cells(Sheets("Sheet3").Rows.Count, "D").End(xlUp).Row
For i = 14 To lastRowSheet3
    Sheets("Sheet3").Cells(i, "D").Value = i - 13 ' 14行对应1，15行对应2，以此类推
Next i

' Sheet2的排序操作（已修正语法错误）
ActiveWorkbook.Worksheets("Sheet2").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet2").AutoFilter.Sort.SortFields.Add2 Key:= _
    Range("L13:L482"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
    :=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet2").AutoFilter.Sort
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With

给Sheet2过滤后的可见行重新编号 #

如果Sheet2的过滤结果也需要重新编号，在排序完成后添加以下代码（假设编号列是Sheet2的A列，行范围从A14开始）：

' 给Sheet2过滤后的可见行重新编号
Dim num As Integer
Dim cell As Range
num = 1
For Each cell In Sheets("Sheet2").Range("A14:A482").SpecialCells(xlCellTypeVisible)
    cell.Value = num
    num = num + 1
Next cell

注意事项 #

• 把代码中的列标识（如"D"、"A"）替换为你实际使用的编号列字母
• 若数据行的起始行不是14，调整代码中的起始行数字（比如i = 14改为对应行号）
• 如果Sheet2的行范围不是A14:A482，修改为实际的数据行范围

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