Vba代码根据下拉框选择删除数据

Question

I have a sheet that has a List box when that is selected codes appear.如果选择了代码，Excel 会将工作表中的数据（具有相同代码）复制到报价表中。

如果我在同一个列表框中进行更改并选择另一个代码，我需要 excel 去查找旧数据并在报价表中将其删除。

Public Sub delete_selected_rows()
    Dim rng1 As Range, rng2 As Range, rngToDel As Range, c As Range
    Dim lastRow As Long

    With Worksheets("Q")
        lastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
        Set rng1 = .Range("B1:B" & lastRow)
    End With

    Set rng2 = Worksheets("SO").Range("D35")
    For Each c In rng1
        If Not IsError(Application.Match(c.Value, rng2, 0)) Then
            'if value from rng1 is found in rng2 then remember this cell for deleting
            If rngToDel Is Nothing Then
                Set rngToDel = c
            Else
                Set rngToDel = Union(rngToDel, c)
            End If
        End If
    Next c

    If Not rngToDel Is Nothing Then rngToDel.CurrentRegion.Delete
End Sub

如何让 CurrentRegion 计算删除的额外 30 行？

Answer 1

VBA 的 ISERROR 不会捕获 MATCH 工作表函数失败导致的错误。您需要以不同的方式构建该部分。

Public Sub delete_selected_rows()

    Dim rng1 As Range, rng2 As Range, rngToDel As Range, c As Range
    Dim lastRow As Long
    Dim R As Long

    With Worksheets("Q")
        lastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
        Set rng1 = .Range("B1:B" & lastRow)
    End With

    Set rng2 = Worksheets("SO").Range("D35")
    For Each c In rng1
        On Error Resume Next
        R = 0
        R = WorksheetFunction.Match(c.Value, rng2, 0)
        On Error GoTo 0
        If R Then
            'if value from rng1 is found in rng2 then remember this cell for deleting
            ' R is the row number in rng2 where a match was found
            ' since rng2 is a single cell, R would always be 1, if found
            ' If rng2 = D35 MATCH be an overkill. Why not simply compare?
        Else
            If rngToDel Is Nothing Then
                Set rngToDel = c
            Else
                Set rngToDel = Union(rngToDel, c)
            End If
        End If
    Next c

    If Not rngToDel Is Nothing Then rngToDel.CurrentRegion.Delete
End Sub

请注意我的 cmets 关于 rng2。会不会有什么错误？ SO.D35 包含什么？如果它包含一串值，其中一个值可能是您要查找的值 MATCH 是错误的函数。

您似乎打算将所有要删除的项目放在一个尖峰上，并在最后一口气删除它们。我不确定这是否可能，而且对我来说已经晚了。更常见的方法是一次删除一行，因为一旦删除一行，该行下方的所有行号都会更改。您可以在 ScreenUpdating 关闭的情况下运行整个代码，并在所有删除完成后设置 Application.ScreenUpdating = True。