Excel VBA技术问询：如何删除筛选区域除首条可见行外的所有行

你的代码会删除所有筛选行，核心问题是没有跳过第一条可见行，且正向删除行容易导致索引错乱。以下是两种可行的修改方案：

方案一：处理不连续可见区域（推荐） #

该方案能应对筛选后可见行不连续的情况，同时避免删除行时的索引问题：

Sub KeepFirstFilteredRow()
    Dim visibleRng As Range
    Dim areaCount As Integer
    Dim i As Integer
    
    ' 执行筛选操作
    Range("A1").AutoFilter Field:=1, Criteria1:="Apple"
    
    ' 捕获无可见行的情况，防止报错
    On Error Resume Next
    Set visibleRng = Range("A2:A7").SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
    
    If Not visibleRng Is Nothing Then
        areaCount = visibleRng.Areas.Count
        
        ' 从最后一个区域反向删除，避免行号错乱
        For i = areaCount To 2 Step -1
            visibleRng.Areas(i).EntireRow.Delete
        Next i
        
        ' 若第一个可见区域包含多行，仅保留第一行
        If visibleRng.Areas(1).Rows.Count > 1 Then
            visibleRng.Areas(1).Offset(1).Resize(visibleRng.Areas(1).Rows.Count - 1).EntireRow.Delete
        End If
    End If
    
    ' 如需关闭筛选，取消下方注释
    ' ActiveSheet.AutoFilterMode = False
End Sub

关键逻辑说明 #

• 用On Error Resume Next处理无匹配结果的场景，避免运行时错误
• 通过Areas属性拆分不连续的可见区域，确保所有筛选行都被覆盖
• 反向遍历区域删除，防止删除行导致后续区域的位置偏移
• 单独处理第一个区域的多行情况，保留首行、删除其余行

方案二：通过区域差集删除（简洁版） #

利用Excel的区域运算，直接排除第一条可见行后删除剩余部分：

Sub KeepFirstFilteredRow_Simple()
    Dim firstVisibleRow As Range
    Dim allVisibleRows As Range
    
    ' 执行筛选
    Range("A1").AutoFilter Field:=1, Criteria1:="Apple"
    
    On Error Resume Next
    Set allVisibleRows = Range("A2:A7").SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
    
    If Not allVisibleRows Is Nothing Then
        ' 定位第一条可见行
        Set firstVisibleRow = allVisibleRows.Cells(1).EntireRow
        
        ' 构建待删除区域：所有可见行减去第一条
        Set allVisibleRows = Application.Subtract(allVisibleRows.EntireRow, firstVisibleRow)
        
        If Not allVisibleRows Is Nothing Then
            allVisibleRows.Delete
        End If
    End If
End Sub

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