☰

VBA 代码执行非常缓慢

tag-icon • tag-icon microsoft-excel vba microsoft-excel-2016
VBA 代码执行非常缓慢

我是 VBA 新手，所以我写的代码很粗糙。抱歉。

我的问题的本质是，我需要从大约 45,000 行的工作表中删除重复行。每次删除行的迭代大约需要 30 秒才能完成，而我需要对数千行执行此操作。有什么建议可以改进我的代码，使这一切运行得更快吗？

Sub delete_duplicate_rows()
For i = 1 To 85000
    If ActiveCell <> ActiveCell.Offset(1, 0) Or ActiveCell.Offset(0, -1) <> ActiveCell.Offset(1, -1) Or ActiveCell.Offset(0, 1) <> ActiveCell.Offset(1, 1) Or ActiveCell.Offset(0, 2) <> ActiveCell.Offset(1, 2) Or ActiveCell.Offset(0, 3) <> ActiveCell.Offset(1, 3) Or ActiveCell.Offset(0, 4) <> ActiveCell.Offset(1, 4) Or ActiveCell.Offset(0, 5) <> ActiveCell.Offset(1, 5) Or ActiveCell.Offset(0, 6) <> ActiveCell.Offset(1, 6) Or ActiveCell.Offset(0, 7) <> ActiveCell.Offset(1, 7) Or ActiveCell.Offset(0, 8) <> ActiveCell.Offset(1, 8) Or ActiveCell.Offset(0, 9) <> ActiveCell.Offset(1, 9) Or ActiveCell.Offset(0, 10) <> ActiveCell.Offset(1, 10) Or ActiveCell.Offset(0, 11) <> ActiveCell.Offset(1, 11) Or ActiveCell.Offset(0, 12) <> ActiveCell.Offset(1, 12) Or ActiveCell.Offset(0, 13) <> ActiveCell.Offset(1, 13) Then
        ActiveCell.Offset(1, 0).Select
        GoTo NextIteration
    Else
    End If
    If ActiveCell.Value = "" Then Exit Sub
    ActiveCell.Offset(0, -1).Range("A1:Q1").Select
    Selection.Delete Shift:=xlUp
    ActiveCell.Offset(0, 1).Range("A1").Select
NextIteration:
    Next i
End Sub

非常感谢。

答案1

正如其他人所说，你的代码很慢，因为使用了select，activate和goto

我认为性能缓慢的罪魁祸首是一次检查多个条件，因为您可以检查单元格上的变化。

sub delete_duplicate_rows(byref ws as worksheet)

    ' Dim tbl_width as long, tbl_height as long
    ' Dim row_n, col_n as long
    '
    ' This would be the correct form of one line var declarations, as it was stated in the comments
    ' I prefer this style, so I can group things like iters, table sizes, variants for `For each` 
    ' and save some lines and see more code(I've a small screen)

    dim tbl_width as long 
    dim tbl_height as long
    dim row_n as long 
    dim col_n as long
    with ws
        for row_n=tbl_height to 2 step -1
            for col_n=1 to tbl_width
                if .range(.cells(row_n, col_n)) <> .range(.cells(row_n - 1, col_n)) then
                    .range(.cells(row_n , 1), .cells(row_n, tbl_width)).delete shift:=xlShiftUp
                    col_n = tbl_width
            next col_n
        next row_n
    end with

end sub

这不依赖于一组固定的行，不激活或选择任何内容，并且当其中一个条件不满足时，内部循环可以提前退出。这样，您只需检查足够的内容即可决定是否删除。

您可以嵌套另一个循环，这样它将检查所有行，而不仅仅是它下面的行。

相关内容