VBA - 如果存在多個值，則循環遍歷行並刪除

Question

我希望優化通過所有行循環的代碼，並在存在特定值時將其刪除。但是，我目前正在循環使用> 100000行，所以我希望提高速度。

主要用途：循環通過所有的行和刪除，如果一個）細胞（行， 「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