Функции рабочего листа в VBA - Как ускорить этот макрос?

Question

Прежде всего, я довольно новый и неэффективный пользователь VBA, который вы обязательно заметите.

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

По сути, я пытаюсь автоматизировать работу, которая включает в себя множество встроенных функций в Excel.Я получил четыре столбца и X количество строк, которые должны быть заполнены формулами.

Моя идея состояла в том, чтобы вычислить формулу для всех четырех столбцов в строке 1, а затем перейти к строке 2 вплоть до строки X, используя простой цикл «do».Это выглядит примерно так:

    Range("j2").Select
    rownumber = ActiveCell.Row

    Do

        'check if the cell on the left is empty to determine whether it´s the last row or not.

        Range("J" & rownumber).Select
        Range("J" & rownumber).Offset(0, -1).Select

        If IsEmpty(ActiveCell) = True Then        
            Exit Do        
        Else            
            ActiveCell.Offset(0, 1).Select
            ActiveCell.FormulaR1C1 = _                                   "=INDEX(Sheet1!C[-4],MATCH(Sheet2!R[0]C[-6],Sheet1!C[-9],0))"

            'next column

            ActiveCell.Offset(0, 1).Select
            ActiveCell.FormulaR1C1 = _                                   "=INDEX(sheet1!C[-6],MATCH(sheet2!RC[-7],sheet1!C[-10],0))"

            'next column

            ActiveCell.Offset(0, 1).Select
            ActiveCell.FormulaR1C1 = _                                   "=INDEX(sheet3!C[-10],MATCH(sheet2!RC[-2],sheet1!C[-11],0))*sheet2!RC[-1]*sheet2!RC[-10]"

            'next column

            ActiveCell.Offset(0, 1).Select
            ActiveCell.FormulaR1C1 = _                                   "=IF(sheet2!RC[-12]=""BUY"",SUMIFS(sheet4!C[-7],sheet4!C[-12],sheet2!RC[-6],sheet4!C[-11],sheet2!RC[-9])+sheet2!RC[-11],SUMIFS(sheet4!C[-7],sheet4!C[-12],sheet2!RC[-6],sheet4!C[-11],sheet2!RC[-9])-sheet2!RC[-11])"            
            ActiveCell.Offset(0, 1).Select         
            rownumber = rownumber + 1        
        End If

    Loop

Все это работает, но должно быть лучшее решение, которое работает более плавно.Я понимаю, что Excel нужно выполнять много вычислений с вложенными операторами if, но, вероятно, мне потребуется менее 10 минут, чтобы сделать это вручную, поэтому я предполагаю, что мой код замедляет работу.

Answer 1

Я бы изменил ваш код следующим образом:

Dim xlcOld As Calculation: xlcOld = Application.Calculation
Application.Calculation = xlCalculationManual

Dim rownumber As Long: rownumber = 2
Do While Not IsEmpty(Range("I" & rownumber).Value)
    Range("J" & rownumber).FormulaR1C1 = "=INDEX(Sheet1!C[-4],MATCH(Sheet2!R[0]C[-6],Sheet1!C[-9],0))"
    Range("K" & rownumber).FormulaR1C1 = "=INDEX(sheet1!C[-6],MATCH(sheet2!RC[-7],sheet1!C[-10],0))"
    Range("L" & rownumber).FormulaR1C1 = "=INDEX(sheet3!C[-10],MATCH(sheet2!RC[-2],sheet1!C[-11],0))*sheet2!RC[-1]*sheet2!RC[-10]"
    Range("M" & rownumber).FormulaR1C1 = "=IF(sheet2!RC[-12]=""BUY"",SUMIFS(sheet4!C[-7],sheet4!C[-12],sheet2!RC[-6],sheet4!C[-11],sheet2!RC[-9])+sheet2!RC[-11],SUMIFS(sheet4!C[-7],sheet4!C[-12],sheet2!RC[-6],sheet4!C[-11],sheet2!RC[-9])-sheet2!RC[-11])"
    rownumber = rownumber + 1
Loop

Application.Calculation = xlcOld

Обратите внимание, что:

• Автоматический пересчет отключен, поэтому требуется только один пересчет вместо 4-кратных вычислений чисел
• Операции выбора заменяются прямыми ссылками на ячейки

Как указывает BigBen, это может быть еще более эффективным, если писать формулы за один раз:

Dim xlcOld As Calculation: xlcOld = Application.Calculation
Application.Calculation = xlCalculationManual

Dim firstrow As Long: firstrow = 2
Dim lastrow As Long: lastrow = firstrow
Do While Not IsEmpty(Range("I" & lastrow).Value)
    lastrow = lastrow + 1
Loop
lastrow = lastrow - 1
Range("J" & firstrow & ":J" & lastrow).FormulaR1C1 = "=INDEX(Sheet1!C[-4],MATCH(Sheet2!R[0]C[-6],Sheet1!C[-9],0))"
Range("K" & firstrow & ":J" & lastrow).FormulaR1C1 = "=INDEX(sheet1!C[-6],MATCH(sheet2!RC[-7],sheet1!C[-10],0))"
Range("L" & firstrow & ":J" & lastrow).FormulaR1C1 = "=INDEX(sheet3!C[-10],MATCH(sheet2!RC[-2],sheet1!C[-11],0))*sheet2!RC[-1]*sheet2!RC[-10]"
Range("M" & firstrow & ":J" & lastrow).FormulaR1C1 = "=IF(sheet2!RC[-12]=""BUY"",SUMIFS(sheet4!C[-7],sheet4!C[-12],sheet2!RC[-6],sheet4!C[-11],sheet2!RC[-9])+sheet2!RC[-11],SUMIFS(sheet4!C[-7],sheet4!C[-12],sheet2!RC[-6],sheet4!C[-11],sheet2!RC[-9])-sheet2!RC[-11])"

Application.Calculation = xlcOld

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

Кроме того, вы можете найти последнюю строку с Range.End(xlUp), но этозависит от фактического макета вашего листа, поэтому я не убрал цикл подсчета количества строк.