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 に答える