オートフィルタでの削除には時間がかかりすぎます

Question

私は約8000以上の行を持っています。オートフィルタを使用して行を削除するには数分かかります。私はオートフィルターが（行ごとにループを繰り返すのではなく）削除するための最速の方法だと思った。どうすればスピードアップできますか？より速い方法がありますか？公平を期すために、行の半分はXDに削除され

With ThisWorkbook.Worksheets("Upload") 
    lastRow = .Cells(.Rows.Count, "S").End(xlUp).Row 
    Set dataRng = .Range(.Cells(4, 1), .Cells(lastRow, 19)) 
    dataRng.AutoFilter field:=19, Criteria1:="=0" 
    Application.DisplayAlerts = False 
    dataRng.Offset(1, 0).Resize(dataRng.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Rows.Delete 
    Application.DisplayAlerts = True 
    .ShowAllData 
End With 

Answer 1

私はオートフィルタが行くための高速な方法であることを基本的な前提にchallangeだろう - バリアント配列をループを倒すのは困難である

このデモでは、これを行う方法を示して、私のシステム処理上、サブ秒で

Sub DEMO() 
    Dim datrng As Range 
    Dim dat, newdat 
    Dim i As Long, j As Long, k As Long 
    With ThisWorkbook.Worksheets("Upload") 
     Set datrng = .Range(.Cells(1, 1), .Cells(.Rows.Count, "S").End(xlUp)) 
    End With 
    dat = datrng.Value 
    ReDim newdat(1 To UBound(dat, 1), 1 To UBound(dat, 2)) 
    j = 1 
    For i = 1 To UBound(dat, 1) 
     If dat(i, 19) <> 0 Then ' test for items you want to keep 
      For k = 1 To UBound(dat, 2) 
       newdat(j, k) = dat(i, k) 
      Next 
      j = j + 1 
     End If 
    Next 

    datrng = newdat 
End Sub 

Answer 2

を半分の実行を削除する8000の+の行は、私はスピードのために、マクロをテストし、ソートautofilteringおよび削除することは、アレイを構築、その後高速であることがわかりました。

タイミングコードhereを使用すると、100k行のランダムデータ（0〜4の間の25列の乱数）で元のコードを実行します。

は-Originalコードは、クリスが提示-The配列コードは、それを実行している（-Theコードは以下の0.84秒かかった

1.91秒

を取っしようとしました

（のみそれをスピードアップするために50K行、ここで走った）78秒かかりました030の範囲が上部または下部にソートされている場合は、ほとんど差がありませんでした。

内蔵時計はvbaでは素晴らしいわけではありませんが、違いがあれば分かりやすいと思います、フィルタリング、削除は少なくともこの場合の配列ほど高速です。

以下のコードは、単に元のコード

Sub test() 

With Sheets("sheet1") 
    lastRow = .Range("S" & .Rows.Count).End(xlUp).Row 
    Set dataRng = .Range(.Cells(4, 1), .Cells(lastRow, 25)) 
    dataRng.Sort key1:=Range("S4"), order1:=xlDescending, Header:=xlYes 
    dataRng.AutoFilter field:=19, Criteria1:="=0" 
    Application.DisplayAlerts = False 
    dataRng.Offset(1, 0).Resize(dataRng.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Rows.Delete 
    Application.DisplayAlerts = True 
    .ShowAllData 
End With 
End Sub