Макрос замораживания Excel

Question

У меня есть макрос, который объединяет один старый и один новый лист (т.е. обновляет старый лист). Макрос проверяет, изменились ли там значения, и если есть изменения, новые значения из нового макроса заполняются до старого.

Несколько раз работал нормально, пока я не попытался обновить старый лист. с новым листом, содержащим 1000 дополнительных записей / строк (около 4000 записей). Когда макрос запускается, индикатор выполнения в нижней части Excel начинает отображать мерцающий текст («Расчет 8 потоков»).

В чем может быть причина этой проблемы?

Dim wb1 As Excel.Workbook
Set wb1 = Workbooks.Open(Orignial_excel)
Dim wb2 As Excel.Workbook
Set wb2 = Workbooks.Open(New_excel)


' get number of Rows in both the excels

Dim Ori_row_count
Dim New_row_count
Dim sh As Worksheet
Dim sh1 As Worksheet
Dim BB
Dim FF
Dim Ori_row_count_Up
Dim New_row_count_UP
Set sh = wb1.Sheets("Detail")
Set sh1 = wb2.Sheets("FC Detail")
Ori_row_count = sh.Range("A1", sh.Range("A1").End(xlDown)).Rows.Count
New_row_count = sh1.Range("A1", sh1.Range("A1").End(xlDown)).Rows.Count


' Find out actual row count .
' Original Excel

For BB = 2 To Ori_row_count + 1
    If sh.Cells.Item(BB, 6) = Empty Then
       Ori_row_count_Up = BB
       Exit For
    End If 
Next BB

Ori_row_count = Ori_row_count_Up
Ori_row_count = 743

For FF = 4 To New_row_count
    If sh1.Cells.Item(FF, 6) = Empty Then
        New_row_count_UP = FF
        Exit For
    End If
Next FF

New_row_count = New_row_count_UP

Answer 1

Обратите внимание, что это не всегда находит последнюю использованную строку , но если в строках 1 и 2 нет данных, она найдет самую последнюю строку 1048576

Ori_row_count = sh.Range("A1", sh.Range("A1").End(xlDown)).Rows.Count
New_row_count = sh1.Range("A1", sh1.Range("A1").End(xlDown)).Rows.Count

поэтому ваши циклы будут повторяться 1048576 раз, и из-за 2 циклов это будет выполняться 2 раза.

Используйте это, чтобы найти последнюю использованную строку:

Dim LastUsedRow As Long
LastUsedRow = sh.Cells(sh.Rows.Count, "A").End(xlUp).Row

Похоже, вы используете l oop только для того, чтобы найти первую пустую ячейку sh.Cells.Item(BB, 6) = Empty в столбце F. Я думаю, вы могли бы сделать это, просто заменив l oop

For BB = 2 To Ori_row_count + 1
    If sh.Cells.Item(BB, 6) = Empty Then
       Ori_row_count_Up = BB
       Exit For
    End If 
Next BB

просто

Dim NextEpmtyRowF As Long
NextEpmtyRowF = sh.Cells(2, "F").End(xlDown).Row + 1

If sh.Cells(2, "F").Value = vbNullString Then
    NextEpmtyRowF = 2
ElseIf sh.Cells(3, "F").Value = vbNullString Or NextEpmtyRowF >= sh.Rows.Count Then
    NextEpmtyRowF = 3
End If

Если вы хотите, чтобы следующая строка epmty после всех данных в столбце F, вы могли бы даже использовать следующее вместо l oop:

Dim NextEpmtyRowF As Long
NextEpmtyRowF = sh.Cells(sh.Rows.Count, "F").End(xlUp).Row + 1