提高VBA性能

Question

我有一个VBA代码，它用于迭代案例is的排序数据，如果它们相同，则将行转置到匹配的行。

​

在电子表格中大约有20k行需要查看。运行整个代码通常需要20-40分钟。我不确定我做错了什么。

Sub MyCombineRows()


    Dim r As Long
    Dim lngRow As Long
    Dim lngCol As Long
    Dim LastColumn As Long
    Dim sht As Worksheet
    Set sht = ActiveSheet
    'Application.ScreenUpdating = False

'   Set first row to start on (skipping first row of data)
    r = 3
    lngRow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row
    LastColumn = findLastCol(r - 1)

    Do
'       Check to see if columns A is equal to row above it
        If (Cells(r, "A") = Cells(r - 1, "A") And Cells(r, "A").Value <> "") Then
'           Copy value from column to end of row above it
            Range(Cells(r, 1), Cells(r, LastColumn)).Select
            Selection.Cut
            Cells(r - 1, LastColumn + 1).Select
            ActiveSheet.Paste
           'Delete Row
            Rows(r).Delete
            Do
                If (Cells(r, "A") = Cells(r - 1, "A") And Cells(r, "A").Value <> "") Then
                    Dim newLastCol As Long
                    newLastCol = findLastCol(r - 1)
                    Range(Cells(r, 1), Cells(r, LastColumn)).Select
                    Selection.Cut
                    Cells(r - 1, newLastCol + 1).Select
                    ActiveSheet.Paste
                    Rows(r).Delete
                Else
                    r = r + 1
                    If Cells(r, "A").Value = "" Then
                        Exit Do
                    End If
                End If
            Loop Until r = lngRow
        Else
'           Move on to next row
            r = r + 1
        End If
    Loop Until r = lngRow


End Sub

Function findLastCol(rowNum As Long) As Long
    Dim sht As Worksheet
    Set sht = ActiveSheet
    findLastCol = sht.Cells(rowNum, sht.Columns.Count).End(xlToLeft).Column
End Function

Answer 1

可能是删除减慢了你的速度，因为它每次都会尝试更新UI，这通常是相当慢的。在代码开始处尝试Application.ScreenUpdating = False，然后在代码结束时再次将其切换为true。

或者，只需使用标志标记为删除，并删除所有在末尾设置了标志的行。