Question

我希望优化遍历所有行的代码，如果存在某个值，则删除它。但是，我目前正在浏览＆gt; 100000行，所以我希望提高速度。

主要用途：遍历所有行并删除它，如果 a）单元格（行，“A”）。value =“X1”， b）单元格（行，“S”）。value =“X2”， c）单元格（行，“AW”）。value =“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

通过对要删除的列应用自动填充程序进行优化，如果值存在，代码将删除它们。我很快就做到了，未经测试，但逻辑有效，希望这有帮助！：）

已添加代码：

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

VBA - 循环遍历行并删除多个值

1 个答案: