vba - VBA 代码 - 未提供所需的 o/p

Question

下面提到的代码用于从 Sheet1 中删除行，这些行在 A 列中的数字不在 sheet2 的 A 列中。

问题：

当它能够匹配数字时，它可以正常工作，即不删除，但当它无法匹配数字时（即 Sheet1 的列 A 的单元格说 A11（对于第 11 行）有 '123'，但它不在工作表 2 的 A 列中）它正在删除该行，但在这种情况下它不适用于下一行第 12 行，因此如果 Sheet1 的 A12 有 123（非匹配编号），则它不会被删除。

Sub Matching()

Dim S1 As Worksheet, S2 As Worksheet, a As Range

    Set S1 = Sheets("Sheet1")
    Set S2 = Sheets("Sheet2")
    For Each a In S1.Range("A1:A1000")
        n = Application.Match(a.Value, S2.Range("A1:A25"), 0)
        If IsError(n) Then
            a.EntireRow.Delete
        End If
    Next
End Sub

Answer 1

您的问题是您正在删除一行并且仍在增加For...Each，因此，您最终会在每次删除后跳过该行。

例如，如果S1.Range("A6")没有匹配项，则删除第 6 行。接下来会发生问题所在，之前的范围 A7 变为新的 A6，因此当您增加计数器时，实际上是在跳过 A7 中的内容。

所以你必须改变你的循环。而不是 a For...Each，您需要使用For循环。然后你有2个选项，首先你可以向后工作（这会容易得多），或者如果你必须向前工作，你必须在删除时减少计数器，但你还必须添加一些其他检查以避免无限循环

选项 1（向后工作）：

Sub Matching()

Dim S1 As Worksheet, S2 As Worksheet, a As Long

    Set S1 = Sheets("Sheet1")
    Set S2 = Sheets("Sheet2")
    For a = 1000 to 1 Step -1
        n = Application.Match(S1.Range("A" & a).Value, S2.Range("A1:A25"), 0)
        If IsError(n) Then
            S1.Row(a).Delete
        End If
    Next
End Sub

选项 2（通过额外检查继续工作）

Dim S1 As Worksheet, S2 As Worksheet, a As Long, maxRow as Long

    Set S1 = Sheets("Sheet1")
    Set S2 = Sheets("Sheet2")
    maxRow = 1000
    For a = 1 To maxRow
        n = Application.Match(S1.Range("A" & a).Value, S2.Range("A1:A25"), 0)
        If IsError(n) Then
            S1.Rows(a).Delete
            a = a - 1           'Decrement counter
            maxRow = maxRow - 1 'Decrement last row to check
        End If

        If a > maxRow Then Exit For 'Safety valve in case last row doesn't match
    Next

End Sub

Answer 2

根据任务的大小，将删除与循环分开可能会更快（一种用于删除和删除之后的标志）。这样做的好处是不会弄乱每个循环并且速度更快。

考虑以下几点：

For Each rngCell In Range("A1:A1000")
    n = Application.Match(S1.Range("A" & a).Value, S2.Range("A1:A25"), 0)
    If IsError(n) Then
        If (rngDelete Is Nothing) Then
            Set rngDelete = rngCell.EntireRow
        Else
            Set rngDelete = Union(rngDelete, rngCell.EntireRow)
        End If
    End If
Next rngCell
rngDelete.Delete

Answer 3

尝试退回范围

Sub Matching()

Dim S1 As Worksheet, S2 As Worksheet, a As Long

    Set S1 = Sheets("Sheet1")
    Set S2 = Sheets("Sheet2")

    For a = 1000 To 1 Step -1
        n = Application.Match(S1.Range("A" & a).Value, S2.Range("E1:E25"), 0)
        If IsError(n) Then
            S1.Range("A" & a).EntireRow.Delete
        End If

    Next a

End Sub