Как предотвратить замедление кода VBA?

Question

Почему этот код работает все медленнее и медленнее при каждом запуске?

Он работал без сбоев первые несколько раз, когда я запускал его. Но через несколько дней выполнение кода занимает все больше времени.

Лист Raw_data имеет одинаковую информацию во многих строках, но с разными датами. Код должен смотреть на лист Raw_data, получать самую последнюю дату и перемещать ее в таблицу данных.

Возможно, есть способ очистить память? Я попытался перезагрузить Windows, но это не решило проблему.

Sub sub_name()

    Dim flag As Boolean
    Dim i, j As Integer
    Dim name1, name2

    i = 2
    flag = True

    While flag = True
        'check if the current cell has data in it
        If Sheets("Raw_Data").Cells(i, 1) <> "" Then
            i = i + 1
        Else
            'if the last row has been reached exit the loop
            flag = False
        End If
    Wend

    i = 2
    j = 2
    flag = True

    name1 = Sheets("Raw_Data").Cells(2, 1)
    Sheets("Data").Cells(j, 1) = name1
    Sheets("Data").Cells(j, 2) = Sheets("Raw_Data").Cells(i, 2)
    Sheets("Data").Cells(j, 3) = Sheets("Raw_Data").Cells(i, 3)
    Sheets("Data").Cells(j, 4) = Sheets("Raw_Data").Cells(i, 4)
    Sheets("Data").Cells(j, 5) = Sheets("Raw_Data").Cells(i, 5)
    Sheets("Data").Cells(j, 6) = Sheets("Raw_Data").Cells(i, 6)
    Sheets("Data").Cells(j, 7) = Sheets("Raw_Data").Cells(i, 7)
    Sheets("Data").Cells(j, 8) = Sheets("Raw_Data").Cells(i, 8)
    Sheets("Data").Cells(j, 9) = Sheets("Raw_Data").Cells(i, 9)
    Sheets("Data").Cells(j, 10) = Sheets("Raw_Data").Cells(i, 10)
    Sheets("Data").Cells(j, 11) = Sheets("Raw_Data").Cells(i, 11)
    Sheets("Data").Cells(j, 12) = Sheets("Raw_Data").Cells(i, 12)
    Sheets("Data").Cells(j, 13) = Sheets("Raw_Data").Cells(i, 13)
    Sheets("Data").Cells(j, 14) = Sheets("Raw_Data").Cells(i, 14)
    Sheets("Data").Cells(j, 15) = Sheets("Raw_Data").Cells(i, 15)

    i = 3
    j = 3

    While flag = True
        'check if the current cell has data in it
        If Sheets("Raw_Data").Cells(i, 1) <> "" Then
            name2 = Sheets("Raw_Data").Cells(i, 1)
            If name2 <> name1 Then
                Sheets("Data").Cells(j, 1) = name2
                Sheets("Data").Cells(j, 2) = Sheets("Raw_Data").Cells(i, 2)
                Sheets("Data").Cells(j, 3) = Sheets("Raw_Data").Cells(i, 3)
                Sheets("Data").Cells(j, 4) = Sheets("Raw_Data").Cells(i, 4)
                Sheets("Data").Cells(j, 5) = Sheets("Raw_Data").Cells(i, 5)
                Sheets("Data").Cells(j, 6) = Sheets("Raw_Data").Cells(i, 6)
                Sheets("Data").Cells(j, 7) = Sheets("Raw_Data").Cells(i, 7)
                Sheets("Data").Cells(j, 8) = Sheets("Raw_Data").Cells(i, 8)
                Sheets("Data").Cells(j, 9) = Sheets("Raw_Data").Cells(i, 9)
                Sheets("Data").Cells(j, 10) = Sheets("Raw_Data").Cells(i, 10)
                Sheets("Data").Cells(j, 11) = Sheets("Raw_Data").Cells(i, 11)
                Sheets("Data").Cells(j, 12) = Sheets("Raw_Data").Cells(i, 12)
                Sheets("Data").Cells(j, 13) = Sheets("Raw_Data").Cells(i, 13)
                Sheets("Data").Cells(j, 14) = Sheets("Raw_Data").Cells(i, 14)
                Sheets("Data").Cells(j, 15) = Sheets("Raw_Data").Cells(i, 15)

                name1 = name2
                j = j + 1
            End If

            i = i + 1
        Else
            'if the last row has been reached exit the loop
            'ensure that the last data point is recorded
            Sheets("Data").Cells(j, 1) = name1
            Sheets("Data").Cells(j, 2) = Sheets("Raw_Data").Cells(i, 2)
            Sheets("Data").Cells(j, 3) = Sheets("Raw_Data").Cells(i, 3)
            Sheets("Data").Cells(j, 4) = Sheets("Raw_Data").Cells(i, 4)
            Sheets("Data").Cells(j, 5) = Sheets("Raw_Data").Cells(i, 5)
            Sheets("Data").Cells(j, 6) = Sheets("Raw_Data").Cells(i, 6)
            Sheets("Data").Cells(j, 7) = Sheets("Raw_Data").Cells(i, 7)
            Sheets("Data").Cells(j, 8) = Sheets("Raw_Data").Cells(i, 8)
            Sheets("Data").Cells(j, 9) = Sheets("Raw_Data").Cells(i, 9)
            Sheets("Data").Cells(j, 10) = Sheets("Raw_Data").Cells(i, 10)
            Sheets("Data").Cells(j, 11) = Sheets("Raw_Data").Cells(i, 11)
            Sheets("Data").Cells(j, 12) = Sheets("Raw_Data").Cells(i, 12)
            Sheets("Data").Cells(j, 13) = Sheets("Raw_Data").Cells(i, 13)
            Sheets("Data").Cells(j, 14) = Sheets("Raw_Data").Cells(i, 14)
            Sheets("Data").Cells(j, 15) = Sheets("Raw_Data").Cells(i, 15)

            flag = False
        End If
    Wend

End Sub

Answer 1

Ваш код может быть намного эффективнее (и короче), если вы копируете строки за одну операцию:

Sub sub_name()
    Dim i As Long, j As Long
    Dim currentName, nextName

    i = 2
    j = 2
    currentName = Chr(0) 'not a real name...
    Do
        nextName = Sheets("Raw_Data").Cells(i, 1)
        If nextName <> "" Then
            If nextName <> currentName Then
                currentName = nextName 'set the new name...
                DoCopy j, i
                j = j + 1
            End If
            i = i + 1
        Else
            DoCopy j, i - 1 'copy last row with data (so i-1) then exit
            Exit Do
        End If
    Loop

End Sub

Sub DoCopy(j As Long, i As Long)
    Sheets("Data").Cells(j, 1).Resize(1, 15).Value = _
           Sheets("Raw_Data").Cells(i, 1).Resize(1, 15).Value
End Sub

Если вам нужно больше ускорения, переключитесь на работу с массивами.