VBA代码 - 没有提供所需的o / p

Question

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

问题：

当它能够匹配数字时，它可以正常工作，即不能删除，但是当它无法匹配数字时（例如，Sheet1的Colum A的单元格说A11（第11行）有'123'，但它不在A列中of Sheet 2）它正在删除该行，但是在这种情况下第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中的内容。

所以你必须在你的循环中做出改变。您需要使用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