Question

我正在尝试创建一个excel宏（在谷歌的帮助下）搜索一组数据，使用它作为条件然后搜索我的工作簿中的所有工作表并删除其中包含匹配值的任何行。

本表中的编码只选择一个特定的工作表，我怎么能修改它以使所有工作表（我发布数据的标准表除外）都符合标准？

此外，似乎匹配值在单元格A1中，该行不会被删除。不知道为什么会这样。

我尝试使用计数器或下一个ws，但无法弄清楚问题是什么。非常感谢任何帮助！

Sub Delete_with_Autofilter_More_Criteria()

Dim rng As Range
Dim cell As Range
Dim CriteriaRng As Range
Dim calcmode As Long


With Application
    calcmode = .Calculation
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
End With

'setting criteria
With Sheets("Sheet1")        
      Set CriteriaRng = .Range("A1", .Cells(Rows.Count, "A").End(xlUp))
End With

'Loop through the cells in the Criteria range
For Each cell In CriteriaRng

    With Sheets("export3")

        'Firstly, remove the AutoFilter
        .AutoFilterMode = False

        'Apply the filter
        .Range("A1:A" & .Rows.Count).AutoFilter Field:=1, Criteria1:=cell.Value

        With .AutoFilter.Range
            Set rng = Nothing
            On Error Resume Next
            Set rng = .Offset(1, 0).Resize(.Rows.Count - 1, 1) _
                      .SpecialCells(xlCellTypeVisible)
            On Error GoTo 0
            If Not rng Is Nothing Then rng.EntireRow.Delete                               
        End With

        'Remove the AutoFilter
        .AutoFilterMode = False
    End With

Next cell

With Application
    .ScreenUpdating = True
    .Calculation = calcmode
End With

End Sub

Answer 1

下面修改后的代码将帮助您遍历ThisWorkbook中的所有表格（除了“ Sheet1 ”，其中包含 CriteriaRng < / strong>设置）。

Sub Delete_with_Autofilter_More_Criteria() Dim rng As Range Dim cell As Range Dim CriteriaRng As Range Dim calcmode As Long Dim sht As Worksheet With Application calcmode = .Calculation .Calculation = xlCalculationManual .ScreenUpdating = False End With 'setting criteria With Sheets("Sheet1") Set CriteriaRng = .Range("A1", .Cells(Rows.Count, "A").End(xlUp)) End With ' loop through all sheets in this workbook For Each sht In ThisWorkbook.Sheets ' don't run this comparison for the original sheet1 If sht.Name <> "Sheet1" Then 'Loop through the cells in the Criteria range For Each cell In CriteriaRng With sht 'Firstly, remove the AutoFilter .AutoFilterMode = False 'Apply the filter .Range("A1:A" & .Rows.Count).AutoFilter Field:=1, Criteria1:=cell.Value With .AutoFilter.Range Set rng = Nothing On Error Resume Next Set rng = .Offset(1, 0).Resize(.Rows.Count - 1, 1) _ .SpecialCells(xlCellTypeVisible) On Error GoTo 0 If Not rng Is Nothing Then rng.EntireRow.Delete End With 'Remove the AutoFilter .AutoFilterMode = False End With Next cell End If Next sht With Application .ScreenUpdating = True .Calculation = calcmode End With End Sub

VBA - 根据一系列数据在多个工作表上删除匹配数据及其行

1 个答案: