VBA根据单元格值删除行答案

【问题标题】：VBA to delete rows based on cell valueVBA根据单元格值删除行
【发布时间】：2017-07-05 21:06:29
【问题描述】：

我正在尝试执行以下操作：

VBA 从特定单元格中查找值
在指定工作表的特定列中匹配这些值
如果值不匹配，则从工作表中删除所有行

我尝试了以下方法 - 代码似乎不起作用

Sub Delete()
    Dim List As Variant
    Dim LR As Long
    Dim r As Long
    List = Worksheets("Sheet1").Cells(28, "C").Value
    LR = Range("E" & Rows.Count).End(xlUp).Row
    For r = LR To 1 Step -1
        If IsError(Application.Match(Range("E" & r).Value, List, False)) Then
            Worksheets("Sheet2").Range("A1:AA36429").Rows(r).Delete
        End If
    Next r
End Sub

【问题讨论】：

描述“代码似乎不起作用”太模糊了。您能否请edit 提出问题并添加说明您对代码有哪些确切问题？

标签： vba excel

【解决方案1】：

试试这个：

Sub Delete()    

Dim i As Integer
Dim LR As Long
Dim List As Variant

LR = Range("E" & Rows.Count).End(xlUp).Row
List = Worksheets("Sheet1").Cells(28, "C").Value   

For i = 1 To LR
    If Cells(i, "E").Value = List Then
        Worksheets("Sheet1").Rows(i).Delete
    End If
Next i

End Sub

【讨论】：

快速提问，如果我希望列表为数组，代码是否仍然有效。
简短的回答是肯定的，但您是在寻找固定长度的数组还是可变大小的数组？另外，您将如何将值提供给数组？
固定长度 - 2
Dim Ar As Variant Ar = Range("A1:A2").Value
我有 3 张纸，其中大约有 30K 行，这个脚本运行了很长时间，我不得不杀死文件（~1 小时）。有什么优化建议

【解决方案2】：

我认为您有几种方法可以解决此问题，但我所知道的最快方法是使用 MATCH 将范围内的值与数组中的值进行比较。请注意，这有一个限制为 4000 左右的值，以在失败之前进行比较。出于您的目的，我认为以下方法会起作用：

Sub test1()
    Dim x As Long
    Dim array1() As Variant
    Dim array2() As Variant

    array1 = Array("ABC", "XYX")
    array2 = Range("A1:A2")

    If IsNumeric(Application.Match(Range("A1").Value, array1, 0)) Then
        x = 1
    ElseIf IsNumeric(Application.Match(Range("A1").Value, array2, 0)) Then
        x = IsNumeric(Application.Match(Range("A1").Value, array2, 0))
    End If

    'If x is not found in these arrays, x will be 0.
    MsgBox x
End Sub

另一种类似的方式如下：

Sub test2()
    Dim array1() As Variant
    Dim FilterArray() As String
    Dim x As Variant

    x = Range("A1").Value
    array1 = Array("ABC", "RANDOM", "VBA")

    FilterArray = Filter(SourceArray:=array1, _
                          Match:=strText, _
                          Include:=True, _
                          Compare:=vbTextCompare)

    If UBound(FindOutArray) = -1 Then
        MsgBox "No, Array doesn't contain this item - " & x
    Else
        MsgBox "Yes, Array contains this item - " & x
    End If

End Sub

因此，如果我们将所有这些结合在一起（顺便说一句，我测试了这个）：

Sub Delete()

Dim i As Integer
Dim LR As Long
Dim List() As Variant
Dim x As Long

LR = Range("E" & Rows.count).End(xlUp).Row
List = Worksheets("Sheet1").Range("A1:A2").Value

For i = 1 To LR
    If IsNumeric(Application.Match(Cells(i, "E").Value, List, 0)) Then
        Worksheets("Sheet1").Cells(i, "E").Value = ""
    End If
Next i

Worksheets("Sheet1").Columns("E").SpecialCells(xlCellTypeBlanks).Cells.Delete

End Sub

这会将具有在数组中找到的值的单元格设置为空白。循环完成后，将删除空白单元格。如果您想将整行向上移动，请将其用作最后一行：

Worksheets("Sheet1").Columns("E").SpecialCells(xlCellTypeBlanks).EntireRow.Delete

【讨论】：