如何搜索多个模式以删除行?

时间:2019-07-05 13:16:26

标签: excel vba

我想创建一个宏,以删除Excel文档中包含某些值(例如“红色”,“蓝色”和“黄色”)的所有行。

我找到了一些适用于单个值的代码。我试图进行一些更改,但无法使它适用于多个值。

Sub Colors() 

    Dim pattern As String
    pattern = "red"
    RowCount = ActiveSheet.UsedRange.Rows.Count

    Dim i As Integer
    For i = 1 To RowCount
        Dim j As Integer
        For j = 1 To 1
            If Cells(i, j) = pattern Then
                Cells(i, j).EntireRow.Delete
            End If
        Next j
    Next i

End Sub

您如何列出更多模式?

4 个答案:

答案 0 :(得分:3)

类似的事情应该起作用。您可以使用集合来保存所有模式并进行遍历。另外,您也可以在If语句上使用一系列or语句。

进行一些调整以改善此问题。您可能还想在不与单元格进行交互的位置显式声明一个工作表。此外,由于不需要,我删除了For j循环。

Option Explicit

Sub Colors()

    Dim i        As Long
    Dim j        As Long
    Dim RowCount As Long
    Dim patterns As Collection: Set patterns = New Collection
    Dim pattern  As Variant

    patterns.Add "red"
    patterns.Add "blue"
    patterns.Add "yellow"

    RowCount = ActiveSheet.UsedRange.Rows.Count

    For i = RowCount To 1 Step -1
        For Each pattern In patterns
            If Cells(i, 1) = pattern Then 
                Cells(i, 1).EntireRow.Delete
                exit for
            end if
        Next
    Next

End Sub

答案 1 :(得分:0)

Sub Colors()

Dim pattern As String
Dim i As Long, j As Long

RowCount = ActiveSheet.UsedRange.Rows.Count

For i = RowCount To 1 Step -1
    If Cells(i, 1) = "red" Or Cells(i, 1) = "blue" Or Cells(i, 1) = "yellow" Then
       Cells(i, 1).EntireRow.Delete
    End If
Next i

End Sub

您可以使用or运算符来指定多个条件。这样会搜索第1列,您可以更改单元格索引以调整行。

答案 2 :(得分:0)

尝试:

Option Explicit

Sub Colors()

    Dim arr As Variant
    Dim LastRow As Long, i As Long, j As Long
    Dim Color As String

    arr = Array("Red", "Blue", "Yellow")

    'It is better to create a with statement with th workbook you want to work
    With ThisWorkbook.Worksheets("Sheet1")
        'It is better to avoid the usedrange, instead use a specific when you calculating the lastrow
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        'Loop if you delete you loop from bottom to top
        For i = LastRow To 1 Step -1
            'Get the color in cell i column A
            Color = .Cells(i, 1).Value

            'Loop array with colors
            For j = LBound(arr) To UBound(arr)
                'If color much
                If Color = arr(j) Then
                    'Delete row
                    .Rows(i).EntireRow.Delete
                    Exit For
                End If

            Next j

        Next i

    End With

End Sub

答案 3 :(得分:0)

不要循环。在更大的数据集上,这将花费很长时间。

出于相同的原因,请不要删除。

相反:过滤,将数据集复制到新工作表,然后删除旧工作表。

Sub Macro1()
'
' Macro1 Macro
'

    Dim mySheetname As String
    Dim mySheetnameOld As String
    Dim lastRow As Long

    'Replace "Sheet1" with your sheet name.
    mySheetname = "Sheet1"
    mySheetnameOld = mySheetname & "_Old"
    lastRow = Cells(Rows.Count, 1).End(xlUp).Row

    Sheets(mySheetname).Name = mySheetname & "_Old"

    ' Add/remove your cell criteria to/from the filter array
    Sheets(mySheetnameOld).Rows("1:" & lastRow).AutoFilter Field:=1, Criteria1:=Array( _
        "Blue", "Green", "Red", "Yellow"), Operator:=xlFilterValues
    Sheets.Add After:=Sheets(mySheetnameOld)
    ActiveSheet.Name = mySheetname

    Sheets(mySheetnameOld).Select
    lastRow = Cells(Rows.Count, 1).End(xlUp).Row
    Rows("1:" & lastRow).Copy Sheets(mySheetname).Cells(1, 1)

    Application.DisplayAlerts = False
    Sheets("Sheet1_Old").Delete
    Application.DisplayAlerts = True

End Sub