У меня есть кнопка, которая вызывает много отдельных макросов. Все работает как положено, но с 1 исключением.

Мне нужно ввести формулу в строке 2 из четырех отдельных столбцов и перетащить формулы вниз до последней заполненной строки. Чтобы добиться этого "легко", я добавил макрос, который будет выбирать из A1:AK700 (никогда не должно быть больше 500 строк, поэтому я перешел на 700, чтобы быть в безопасности) и создать таблицу. Затем вводятся формулы (я делаю таблицу так, чтобы формулы автоматически переходили к последней заполненной строке). Затем у меня есть макрос, чтобы выбрать тот же диапазон и преобразовать его в диапазон. Наконец, у меня есть макрос, который запускается после всего этого, чтобы скопировать и вставить значения, а затем взять две вкладки и создать новый файл с копиями этих вкладок.

Все работает правильно, но в какой-то момент после преобразования в диапазон (или вокруг этой части процесса) Excel сильно замедляется, на некоторое время перестает отвечать, а затем, наконец, запускается снова. Когда все закончится, я перехожу к исходному файлу и к вновь созданному файлу, и форматирование таблицы применяется ко всему листу (вплоть до ячейки ~ 1 048 000!). Понятно, вот почему так долго и перестает отвечать, верно?

Как я могу остановить это?

Я вставляю код в том порядке, в котором он запускается из точки создания таблицы. У меня нет большого опыта написания макросов (около месяца), поэтому любая помощь будет оценена !! И все это нужно делать с помощью макроса. Они хотят, чтобы все произошло одним нажатием кнопки.

Код:

Sub CreateTable()

    Sheet1.ListObjects.Add(xlSrcRange, Range("A1:AK500"), , xlYes).Name = "Table1"

End Sub

Sub FormulaInput()

   Sheets("Activity - Hires").Select
   Range("AH2").Select
   ActiveCell.FormulaR1C1 = _
       "=INDEX(NHO_Global!C[-21],MATCH('Activity - Hires'!RC[-24],NHO_Global!C[-33],0))"
End Sub

Sub FormulaInput2()

    Sheets("Activity - Hires").Select
    Range("AI2").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(AND(ISERROR(RC[-1]),RC[-15]=""Contingent Worker""),""Contingent Worker"",IF(AND(ISERROR(RC[-1]),ISNUMBER(SEARCH(""(Terminated)"",RC[-33]))),""Terminated"",IF(AND(ISERROR(RC[-1]),RC[-34]=TODAY()),""Hired Today"",IF(ISERROR(RC[-1]),""Under Investigation"",""""))))"
End Sub

Sub FormulaInput3()
    Sheets("Activity - Hires").Select
    Range("AJ2").Select
    ActiveCell.FormulaR1C1 = "=IF(ISERROR(RC[-2]),"""",IF(RC[-2]<0,RC[-17],""""))"
End Sub


Sub FormulaInput4()
    Sheets("Activity - Hires").Select
    Range("AK2").Select
    ActiveCell.FormulaR1C1 = _
    "=IF(ISERROR(RC[-3]),"""",IF(RC[-3]<-10,""Obtain Manager Email"",""""))"
End Sub

Sub ConvertToNumber()
 'This is so that the formulas work as the numbers in column J are used, but they're stored as text initially 

    Range("J:J").Select
    With Selection
    Selection.NumberFormat = "General"
    .Value = .Value
    End With

End Sub

Sub ConvertToRange()

    Sheet1.ListObjects("Table1").Unlist

End Sub

Sub CopyPasteValuesActivity()

    Worksheets("Activity - Hires").Select
    Worksheets("Activity - Hires").Range("A1:AK700").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

End Sub


Sub CopyPasteValuesNHO()

    Worksheets("NHO_Global").Select
    Worksheets("NHO_Global").Range("A1:Q700").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

End Sub


Sub SaveSepFile()

    Sheets(Array("Activity - Hires", "NHO_Global")).Select
    Sheets("Activity - Hires").Activate
    Sheets(Array("Activity - Hires", "NHO_Global")).Copy

End Sub

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

Sub FormulaInput12()

Dim rng As Range
Dim sht As Worksheet
Dim LastRow As Long

Set sht = ThisWorkbook.Sheets("Activity - Hires")
LastRow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row
Set rng = Range("AH2:AH" & LastRow)
rng.Formula = "=INDEX(NHO_Global!C[-21],MATCH('Activity - Hires'!RC[-24],NHO_Global!C[-33],0))"

End Sub

Это позволяет файлу обрабатываться всего за несколько секунд, и все правильно.

|источник

0