☰

根据在另一张表上查找的值删除一张表中的行

tag-icon • tag-icon microsoft-excel-2010 vba
根据在另一张表上查找的值删除一张表中的行

我有一个 Excel 文件，其中一张表（预测数据）上有原始数据，另一张表（NonNSX）上有值列表。我正在尝试编写代码，循环遍历数据上的 D 列，如果在 NonNSX 上找到值列表，则删除数据上的整行。

我需要它检查 Data 上的所有行中的第一个非 NSX 值，然后返回 Data 的顶部，检查 nonNSX 上的第二个值，并循环执行所有这些操作直到完成。在 Data 中，NSX 上经常有多个相同值的重复项，我需要将它们全部删除。

下面的代码可以工作，但每次运行代码时，它只会删除数据中每个值的一行。有什么想法吗？注意：IF 中的“d=d-1”用于调整行号，以查看是否实际删除了一行）

以下是代码：

Sub Remove()

    Set nsx = Sheets("NonNSX")
    Set fc = Sheets("Forecast Data")
    Dim n As Integer
    Dim d As Integer
    Dim r As Integer
    n = 1
    d = 2
    r = 1
    NumRows = fc.Range("D2", fc.Range("D2").End(xlDown)).Rows.Count

    Do Until IsEmpty(nsx.Range("A" & n))
        For r = 1 To NumRows
            If nsx.Range("A" & n) = fc.Range("D" & d) Then
                fc.Range("D" & d).EntireRow.Delete
                Exit For
                d = d - 1
            End If
            d = d + 1
        Next r
        d = 2
        n = n + 1
    Loop

End Sub

答案1

我们可以用 Match 替换其中一个循环。

我们还想从下往上向后循环。

Sub Remove()
Dim nsx As Worksheet
Dim fc As Worksheet

Set nsx = Sheets("NonNSX")
Set fc = Sheets("Forecast Data")

Dim lookUp As Range
Dim n As Long
Dim d As Long

NumRows = fc.Range("D1", fc.Range("D2").End(xlDown)).Rows.Count

Set lookUp = nsx.Range("A1", nsx.Range("A1").End(xlDown))

For n = NumRows To 2 Step -1
    d = 0
    On Error Resume Next
        d = Application.WorksheetFunction.Match(fc.Range("D" & n), lookUp, 0)
    On Error GoTo 0
    If d > 0 Then
        fc.Rows(n).Delete
    End If
Next n



End Sub

相关内容