3

请帮我修改这段代码，但我想保持 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
4

1 回答 1

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
于 2012-10-24T09:13:12.230 回答