Question

我想根据一个条件删除一些行 - 1000/10000但是花费的时间太长。我还尝试了互联网上提供的所有解决方案，即过滤数据，Application.ScreenUpdating = False，设置计时器等。

Private Sub Remove_incomplete_records_Click()
Dim n, count As Integer
Dim i As Long
Dim lastrownum As Integer

lastrownum = Sheets("Master_Data").Cells(Rows.count, 1).End(xlUp).Row

Dim varCalcmode

Do While (lastrownum)
    Application.ScreenUpdating = False    
    'for NB,FO etc if field your refernence is not present then delete the entire row.    
    For i = 2 To lastrownum    
        If (Sheets("Master_Data").Cells(i, 2).Value <> "YC" And Sheets("Master_Data").Cells(i, 2).Value <> "YK" And Sheets("Master_Data").Cells(i, 2).Value <> "MK" And Cells(i, 2).Value <> "WK" And Sheets("Master_Data").Cells(i, 2).Value <> "AN") Then
            If (Sheets("Master_Data").Cells(i, 4).Value = "") Then
                On Error Resume Next
                Sheets("Master_Data").Rows(i).EntireRow.Delete Shift:=xlUp
                varCalcmode = Application.Calculation
                Application.Calculation = xlCalculationManual
                Application.ScreenUpdating = False
            Else
            End If
        Else
        End If
    Next i
Loop

Application.Calculation = varCalcmode
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub

请建议更快的方法来执行此操作。

Answer 1

试试这个。它不是逐行删除行，而是找到符合删除条件的每一行，并在一次点击中删除它们。效率更高

Private Sub Remove_incomplete_records_Click()
    Dim i As Long, LastRowNum As Long
    Dim DeleteRng As Range
    Dim varCalcmode As XlCalculation

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

    With Sheets("Master_Data")
        LastRowNum = .Cells(Rows.count, 1).End(xlUp).Row

        'for NB,FO etc if field your refernence is not present then delete the entire row.
        For i = 2 To LastRowNum

                If .Cells(i, 2).Value2 <> "YC" And .Cells(i, 2).Value2 <> "YK" And _
                    .Cells(i, 2).Value2 <> "MK" And Cells(i, 2).Value2 <> "WK" And _
                    .Cells(i, 2).Value2 <> "AN" And .Cells(i, 4).Value2 = vbNullString Then
                        If DeleteRng Is Nothing Then
                            Set DeleteRng = Sheets("Master_Data").Rows(i)
                        Else
                            Set DeleteRng = Union(DeleteRng, shets("Master_Data").Row(i))
                        End If
                    End If
                End If
        Next i
    End With

    If Not DeleteRng Is Nothing Then DeleteRng.EntireRow.Delete Shift:=xlUp

    With Application
        .Calculation = varCalcmode
        .ScreenUpdating = True
    End With
End Sub

Answer 2

这种方法更快。

CKEDITOR.editorConfig = function( config ) {
    config.filebrowserBrowseUrl = '/Scripts/ckeditor/kcfinder/browse.php?opener=ckeditor&type=files';
    config.filebrowserImageBrowseUrl = '/Scripts/ckeditor/kcfinder/browse.php?opener=ckeditor&type=images';
    config.filebrowserFlashBrowseUrl = '/Scripts/ckeditor/kcfinder/browse.php?opener=ckeditor&type=flash';
    config.filebrowserUploadUrl = '/Scripts/ckeditor/kcfinder/upload.php?opener=ckeditor&type=files';
    config.filebrowserImageUploadUrl = '/Scripts/ckeditor/kcfinder/upload.php?opener=ckeditor&type=images';
    config.filebrowserFlashUploadUrl = '/Scripts/ckeditor/kcfinder/upload.php?opener=ckeditor&type=flash';
};

优化在excel vba中删除行的时间

2 个答案: