VBA - 行をループし、複数の値が存在する場合は削除します。

Question

すべての行をループするコードを最適化して、特定の値が存在する場合は削除します。しかし、私は現在、100000を超える行をループしているので、速度を上げたいと思っています。

主な目的：すべての行をループし、それを削除した場合A）セル（行、 "A"）値= "X1"、B）セル（行、 "S"）値。 = "X2"、c）セル（行、 "AW"）。値= "X3"。次のように

私の現在のコードは次のとおりです。

Call FilterData("A", "X1") 
Call FilterData("S", "X2") 
Call FilterData("AW", "X3") 

Sub FilterData(Column as String, Check as String) 
    Dim Firstrow As Long 
    Dim Lastrow As Long 
    Dim Lrow As Long 
    Dim CalcMode As Long 
    Dim ViewMode As Long 

    With Application 
     CalcMode = .Calculation 
     .Calculation = xlCalculationManual 
     .ScreenUpdating = False 
    End With 

    If Not Sheets("XXX").AutoFilterMode Then 
     Sheets("XXX").Range("1:1").AutoFilter 
    End If 
    Sheets("XXX").Range("A2:BT1048576").Sort _ 
    Key1:=Sheets("XXX").Range(Column & "1"), Order1:=xlAscending 

    With Sheets("XXX") 
     .Select 

     ViewMode = ActiveWindow.View 
     ActiveWindow.View = xlNormalView 

     .DisplayPageBreaks = False 

     Firstrow = .UsedRange.Cells(1).Row 
     Lastrow = .UsedRange.Rows(.UsedRange.Rows.Count).Row 

     For Lrow = Lastrow To Firstrow Step -1 
      With .Cells(Lrow, Column) 
       If Not IsError(.Value) Then 
        If .Value = Check Then .EntireRow.Delete 
       End If 
      End With 
     Next Lrow 

    End With 

End Sub 

Answer 1

の最適化を削除したい列に対してautofilerを適用することにより、値が存在する場合、コードは、それらを削除します。私はこれを本当に素早く行い、テストされていませんが、ロジックはうまくいきます。 :)

コードを追加しました：

Sub Filter() 
Dim ColALookup As String 
Dim ColSLookup As String 
Dim colAWlookup As String 
Dim i As Long 

ColALookup = "X1" 
ColSLookup = "X2" 
colAWlookup = "X3" 

With Sheets("XXX") 
.Range("A2", .Range("A" & .Rows.Count).End(xlUp)) _ 
    .AutoFilter Field:=1, Criteria1:=Application.Transpose(ColALookup), Operator:=xlFilterValues 

    .Range("S2", .Range("S" & .Rows.Count).End(xlUp)) _ 
    .AutoFilter Field:=1, Criteria1:=Application.Transpose(ColSLookup), Operator:=xlFilterValues 

    .Range("AW2", .Range("AW" & .Rows.Count).End(xlUp)) _ 
    .AutoFilter Field:=1, Criteria1:=Application.Transpose(colAWlookup), Operator:=xlFilterValues 

.Range("A2", .Range("A" & .Rows.Count).End(xlUp)) _ 
    .SpecialCells(xlCellTypeVisible).EntireRow.Delete 
    .Range("S2", .Range("S" & .Rows.Count).End(xlUp)) _ 
    .SpecialCells(xlCellTypeVisible).EntireRow.Delete 
    .Range("AW2", .Range("AW" & .Rows.Count).End(xlUp)) _ 
    .SpecialCells(xlCellTypeVisible).EntireRow.Delete 
.AutoFilterMode = False 

End With 


End Sub