Question

我有以下VBA函数，它会在输入框中找到输入的信息，并删除具有该值的每一行。

如何更改它以删除除输入值之外的所有行。示例I输入123.我希望它删除除B列中带有123的单元格以外的所有行。

Sub DeleteRows()
    Dim c As Range
    Dim SrchRng As Range
    Dim SrchStr As String

    Set SrchRng = ActiveSheet.Range("B1", ActiveSheet.Range("B4343").End(xlUp))
    SrchStr = InputBox("Please Enter Value")
    Do
        Set c = SrchRng.Find(SrchStr, LookIn:=xlValues)
        If Not c Is Nothing Then c.EntireRow.Delete
    Loop While Not c Is Nothing

End Sub

Answer 1

好吧可能有更好的方法来做到这一点但是我去创建临时表，复制与搜索匹配的行，清除工作表中的所有行，最后复制匹配的行然后删除临时表片：

Sub DeleteRows()
    Dim c As Range, b As Range, SrchRng As Range, SrchStr As String, MasterSheet As Worksheet, TempSheet As Worksheet
    Set MasterSheet = ActiveSheet
    Set SrchRng = ActiveSheet.Range("A1", ActiveSheet.Range("A4343").End(xlUp))
    SrchStr = InputBox("Please Enter Value")
    Worksheets.Add
    Set TempSheet = ActiveSheet
    MasterSheet.Select
    Set c = SrchRng.Find(SrchStr, LookIn:=xlValues)
    Set b = c
    Do
        If Not c Is Nothing Then
            c.EntireRow.Copy
            TempSheet.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteAll
        End If
        Set c = SrchRng.FindNext(After:=c)
        If c.Address = b.Address Then Exit Do
    Loop While Not c Is Nothing
    Range("A2:A" & Rows.Count).EntireRow.ClearContents
    TempSheet.Range("A2:A" & TempSheet.Range("A" & Rows.Count).End(xlUp).Row).EntireRow.Copy
    ActiveSheet.Range("A2:A" & TempSheet.Range("A" & Rows.Count).End(xlUp).Row).PasteSpecial xlPasteAll
    Application.DisplayAlerts = False
    TempSheet.Delete
    Application.DisplayAlerts = True
End Sub

希望有所帮助。

我开始尝试一次性从搜索结果中填充一个数组而没有循环它，但它没有顺利进行，而且我已经没有时间来进一步探索这个了。我的想法是尝试从结果中一次性填充数组，然后选择所有行减去连接数组中的任何内容然后删除。不确定这是多么可能，但如果你有时间的话可能会探索它。

我的测试数据是使用A列，您需要更改B列的几个部分。

更改VBA功能以删除行

1 个答案: