Excel VBA宏可通过输入框使用自动筛选功能删除一个工作表中与另一工作表不匹配的行

Question

我是新手，这是我的第一篇帖子，真的很需要帮助。 我一直在找一个星期都没有用。 我有2个工作表（Sheet1和Sheet2），分配了一个小宏以删除Sheet1中与Sheet2中不匹配的任何行。 我还使用InputBox来捕获基于字段4的用户定义的条件，该方法效果很好并且可以正确过滤。 我的问题与第二部分有关，因为删除是针对整个Sheet1上的匹配项执行的（忽略过滤器）。 我想要的是仅在用户筛选的那些行上进行删除。 如果您能注释您的答案（如果我犯了菜鸟错误，那将是有帮助的），将不胜感激，我们将不胜感激。

Sub DeleteRows()
    'Deletes rows where one cell does not meet criteria

    Dim ws1 As Worksheet: Set ws1 = ActiveWorkbook.Sheets("Sheet1")
    Dim ws2 As Worksheet: Set ws2 = ActiveWorkbook.Sheets("Sheet2")
    Dim criteria As String
    Dim found As Range
    Dim i As Long
    Dim Area As String
    Dim Data As Variant

    'Auto filters by user selection
    Area = InputBox("Enter your required Building(s) - comma separated")

    If InStr(1, Area, ",") > 0 Then
        Data = Split(Area, ",")
        Range("A1").AutoFilter Field:=4, Criteria1:=Trim(Data(0)),     Operator:=xlOr, Criteria2:=Trim(Data(1))
    Else
        Range("A1").AutoFilter Field:=4, Criteria1:=Area
    End If

    'Deletes all rows from Sheet1 that do not match
    For i = 2 To 100
       criteria = ws1.Cells(i, 1).Value

       On Error Resume Next

       Set found = ws2.Range("A:A").Find(What:=criteria, LookAt:=xlWhole)

       On Error GoTo 0

       If found Is Nothing Then
         ws1.Cells(i, 1).EntireRow.Delete

         i = i - 1
       End If

       Next i
End Sub

Answer 1

尝试这个 ：）
该代码检查该行是否被隐藏，如果没有隐藏，则仅删除该行。

Sub DeleteRows()

'Deletes rows where one cell does not meet criteria

Dim ws1 As Worksheet: Set ws1 = ActiveWorkbook.Sheets("Sheet1")

Dim ws2 As Worksheet: Set ws2 = ActiveWorkbook.Sheets("Sheet2")

Dim criteria As String

Dim found As Range

Dim i As Long

Dim Area As String

Dim Data As Variant

'Auto filters by user selection

Area = InputBox("Enter your required Building(s) - comma separated")

If InStr(1, Area, ",") > 0 Then

Data = Split(Area, ",")

Range("A1").AutoFilter Field:=4, Criteria1:=Trim(Data(0)), Operator:=xlOr, Criteria2:=Trim(Data(1))

Else

Range("A1").AutoFilter Field:=4, Criteria1:=Area

End If

'Deletes all rows from Sheet1 that do not match

For i = 2 To 100

criteria = ws1.Cells(i, 1).Value

On Error Resume Next

Set found = ws2.Range("A:A").Find(What:=criteria, LookAt:=xlWhole)

On Error GoTo 0

If found Is Nothing And ws1.Cells(i, 1).EntireRow.Hidden = False Then ' Checks if the row is hidden
 ws1.Cells(i, 1).EntireRow.Delete

 i = i - 1

End If

Next i

End Sub