Улучшение производительности VBA

Question

У меня есть код VBA, который используется для перебора отсортированных данных идентификаторов дел и переносит строку в соответствующую строку, если они совпадают.

В таблице около 20 тыс. Строк для просмотра. Для выполнения всего кода часто требуется 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

Это может быть удаление, которое замедляет вас, поскольку оно пытается обновлять пользовательский интерфейс каждый раз, что обычно довольно медленно.Попробуйте Application.ScreenUpdating = False в начале вашего кода, а затем снова установите его в true, когда вы закончите.

В качестве альтернативы просто пометьте для удаления флажок и удалите все строки, где в конце установлен флаг,