Question

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

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

Answer 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

Answer 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

VBA根据单元格值删除行

2 个答案: