删除我的数组中不包含字符串的行

时间:2012-10-24 09:02:05

标签: excel vba excel-vba

请帮我修改这段代码,但我想保持90%相同。

我想删除不包含数组项的行。所以我的程序删除单元格中带有a,b的行。如何修改下面的代码,以便删除另一个a,b以保留在exec中。

myArr = Array("a","b")
For I = LBound(myArr) To UBound(myArr)

    'Sheet with the data, you can also use Sheets("MySheet")
    With ActiveSheet

        'Firstly, remove the AutoFilter
        .AutoFilterMode = False

        'Apply the filter
        .Range("E1:E" & .Rows.Count).AutoFilter Field:=1, Criteria1:=myArr(I)

        Set rng = Nothing
        With .AutoFilter.Range
            On Error Resume Next
            Set rng = .Offset(1, 0).Resize(.Rows.Count - 1, 1) _
                      .SpecialCells(xlCellTypeVisible)
            On Error GoTo 0
            If Not rng Is Nothing Then rng.EntireRow.Delete
        End With

        'Remove the AutoFilter
        .AutoFilterMode = False
    End With
Next I

1 个答案:

答案 0 :(得分:1)

这对我有用......我已经对代码进行了评论,所以你不应该对它有所了解......

Option Explicit

Dim myArr

Sub Sample()
    Dim ws As Worksheet
    Dim Lrow As Long, i As Long
    Dim rRange As Range, delRange As Range

    myArr = Array("a", "b", "c")

    Set ws = ThisWorkbook.Sheets("MySheet")

    With ws
        '~~> Get last row of Sheet
        Lrow = .Range("A" & .Rows.Count).End(xlUp).Row

        For i = 2 To Lrow
            If Not DoesExists(.Range("A" & i).Value) Then
                If delRange Is Nothing Then
                    Set delRange = .Range("A" & i)
                Else
                    Set delRange = Union(delRange, .Range("A" & i))
                End If
            End If
        Next i

        If Not delRange Is Nothing Then delRange.EntireRow.Delete
    End With
End Sub

Function DoesExists(clVal As Variant) As Boolean
    Dim j As Long

    For j = LBound(myArr) To UBound(myArr)
        If clVal = myArr(j) Then
            DoesExists = True: Exit For
        End If
    Next j
End Function