Макрос останавливается, если в базе данных слишком много строк (скопировать / вставить / рассчитать / скопировать / вставить значения) - PullRequest
Новая
       31

Макрос останавливается, если в базе данных слишком много строк (скопировать / вставить / рассчитать / скопировать / вставить значения)

0 голосов
/ 21 октября 2019

Я пытался найти соответствующие темы на форуме, но ни одна из них, похоже, не подходит именно к моей проблеме. Краткая справка: я довольно сильный пользователь Excel, но весьма ограничен в том, что касается макросов, которые я использую в основном для экономии времени, таких как обработка больших данных и копирование / вставка формул в значения для экономии места.

Я такжеВоспользуйтесь этой возможностью, чтобы поблагодарить всех вас анонимных пользователей, которые мне очень помогли, не зная об этом;)

В этом случае мой макрос имеет следующую цель:

Настройка файла:

  • Одна вкладка с необработанными данными, извлеченными из моей системы (назовите ее "SheetRAW")
  • Одна вкладка для копирования / вставки / очистки необработанных данных и добавления дополнительной информации из основного файла (вызовit "SheetDB")

Шаги макроса:

  1. Скопируйте формулу в строке 1 SheetDB (связана с SheetRAW) и перетащите вниз на столько строк, сколько необходимо
  2. Рассчитать только текущий лист
  3. Копировать, вставить все в значения, начиная со строки 2 вниз (не стирайте строку 1 с формулами)

У меня есть макрос, который отлично работает, кроме случаев, когдаоцепенелыйКоличество строк в SheetRAW слишком велико (скажем, более 300 000 или 400 000 строк). Я хотел бы знать, если есть какой-либо способ изменить код, чтобы избежать этой проблемы?

Обходной путь, который я мог бы использовать в противном случае, состоит в том, чтобы «фрагментировать» мой текущий макрос, чтобы вычислить только первые 100 или 200 тыс. Строк, затем повторите для остальных.

Обратите внимание, что я деактивирую ScreenUpdating в начале и мой Excel всегда настроен на ручной расчет. 

Application.ScreenUpdating = False

ActiveSheet.Outline.ShowLevels RowLevels:=8, ColumnLevels:=8

    ActiveSheet.Calculate

    Dim iRow As Long
    iRow = Application.Max(Range("T1")) - 1

    'Delete previous data
    Range("A9").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).ClearContents

    'Update DB (all rows) for columns A-G
    Range("A7:G7").Select
    Selection.Copy

    Range("A9:G9").Select
    Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(iRow, 0)).Select
    ActiveSheet.Paste
    ActiveSheet.Calculate
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False

    'Update DB (all rows) for columns H-T
    Range("H7:T7").Select
    Selection.Copy

    Range("H9:T9").Select
    Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(iRow, 0)).Select
    ActiveSheet.Paste
    ActiveSheet.Calculate
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False

    'Update DB (all rows) for columns U-AH
    Range("U7:AH7").Select
    Selection.Copy

    Range("U9:AH9").Select
    Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(iRow, 0)).Select
    ActiveSheet.Paste
    ActiveSheet.Calculate
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False

    ActiveWindow.ScrollRow = 1
    Range("A1").Select

ActiveSheet.Outline.ShowLevels RowLevels:=1, ColumnLevels:=1

Application.ScreenUpdating = True
...