2つの異なる列の色とテキストに基づいて行を削除する

Question

列Cに赤色があり、列NにPOボックスという単語がない場合、行を削除しようとしています。そこではNのポップボックスを持っている行を削除しますが、別の方法にしてpoボックスで行を保存することはできません。ここに私のコードです。 13551615は赤の背景色です。

また、これを行うより速い方法がある場合も、これは素晴らしいことです。これは、私の3kの行を実行するために約13秒かかる。私はそれらの中に色の入った20行しかありません。私はすでにそれらを上に並べます。しかし、私は実際には、これが1秒かかる場合でも動作するようにしています。

Dim lngRow As Long 
Dim lngRows As Long 
'Find the last row in Column A 
lngRows = Range("A" & Rows.Count).End(xlUp).Row 

For lngRow = lngRows To 2 Step -1 
    If ActiveWorkbook.Worksheets("Sheet1").Cells(lngRow, "C").FormatConditions(1).Interior.Color = 13551615 Then 
     If Not InStr(1, LCase(Range("N" & lngRow)), LCase("PO Box")) <> 0 Then 
      ActiveWorkbook.Worksheets("Sheet1").Rows(lngRow).EntireRow.Delete 
     End If 
    End If 

Next 

Answer 1

ダブルループは不要です。以下のような1つのステートメントで両方の条件を設定します。これは、ループが1つしかないため、高速化する必要があります。

Dim lngRow As Long 
Dim lngRows As Long 
'Find the last row in Column A 
lngRows = Range("A" & Rows.Count).End(xlUp).Row 

For lngRow = lngRows To 2 Step -1 
    If Not InStr(1, LCase(Range("N" & lngRow)), LCase("PO Box")) <> 0 And Range("C" & lngRow).Interior.Color = 13551615 Then 
      Worksheets("Sheet1").Rows(lngRow).EntireRow.Delete 
    End If 
Next 

Answer 2

これを行うための最速の方法は、すべてのループを使用しにないです。代わりに、AutoFilterを使用する：あなたはトップに色の行をソートする必要はありません

Dim lngRow As Long 
    Dim lngRows As Long 
    'Find the last row in Column A 
    lngRows = Range("A" & Rows.Count).End(xlUp).Row 

    With Range(Worksheets("Sheet1").Rows(1), Worksheets("Sheet1").Rows(lngRows)) 
    .AutoFilter Field:=Columns("C").Column, Criteria1:=13551615, Operator:=xlFilterCellColor 
    .AutoFilter Field:=Columns("N").Column, Criteria1:="<>*PO Box*", Operator:=xlAnd 
    .Offset(1).SpecialCells(xlCellTypeVisible).Delete 
    .AutoFilter ' Turns off autofilter and shows all rows 
    End With 

注意。

また、一致する行がない場合でもこれが機能することに注意してください。

警告：
これは常に後にデータの終わりを最初の行を削除することに注意してください。 （このは、必要に応じてを比較的簡単に修正できます）