Обведите все рабочие листы в рабочей книге и добавьте формулы

Question

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

Формулы - это функции, которые помогают подсчитать количество ячеек, соответствующих определенным критериям.

    Sub Formatting()
For rcell = 1 To lrow
CharacterIndex = InStr(1, sourceSheet.Cells(rcell, Col_Western), "Delivery for Creative", vbBinaryCompare)
If CharacterIndex > 0 Then
On Error Resume Next
deliveryname = "CS"

With ThisWorkbook.Worksheets.add
.Name = deliveryname
sourceSheet.Range(sourceSheet.Cells(rcell, Col_Western), sourceSheet.Cells(lastrow, Col_phone).End(xlDown)).Copy .Range("A1")
Cells.Select
Selection.RowHeight = 50
Selection.ColumnWidth = 30
'Add Autofilter to Row above student details
Range("a8:e8").EntireRow.AutoFilter
End With
End If

Next rcell



For Each Grey_ws In ThisWorkbook.Worksheets
Call Grey_VALUE_AND_RANGE_ALL(Grey_ws)
'do nothing else
Next Grey_ws

End Sub

Sub Grey_VALUE_AND_RANGE_ALL(Grey_ws As Worksheet)
    With Grey_ws
        .Range("A5").FormulaR1C1 = "=Count_items_SmallWest()"
        .Range("A6").FormulaR1C1 = "=Count_items_LargeWest()"
        .Range("B5").FormulaR1C1 = "=Count_items_Small_Asian()"
        .Range("B6").FormulaR1C1 = "=Count_items_Large_Asian()"
        .Range("C5").FormulaR1C1 = "=Count_items_Small_Veg()"
        .Range("C6").FormulaR1C1 = "=Count_items_Large_Veg()"
        .Range("D5:D6").FormulaR1C1 = "=Count_items_Salad()"
        .Range("E5:E6").FormulaR1C1 = "=Count_items_Dessert()"
        .Range("F5:F6").FormulaR1C1 = "=Count_items_Snack()"
    End With
End Sub

Answer 1

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

В вашей подпрограмме Formatting сэндвич цикла For между Application.Calculation и Application.EnableEvents выглядит следующим образом:

Sub Formatting()
    Dim Grey_ws as Worksheet

    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False

    For Each Grey_ws In ThisWorkbook.Worksheets
        Call Grey_VALUE_AND_RANGE_ALL(Grey_ws)
    Next Grey_ws

    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
End Sub

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

Чтобы оставаться в безопасности, обязательно восстановите расчеты и события в случае ошибки:

Sub Formatting()
    Dim Grey_ws As Worksheet
    Dim lInitialCalculation As XlCalculation
    Dim bInitialEnableEvents As Boolean

    On Error GoTo ErrorHandler

    lInitialCalculation = Application.Calculation
    Application.Calculation = xlCalculationManual

    bInitialEnableEvents = Application.EnableEvents
    Application.EnableEvents = False

    For Each Grey_ws In ThisWorkbook.Worksheets
        Call Grey_VALUE_AND_RANGE_ALL(Grey_ws)
    Next Grey_ws

Cleanup:
    On Error Resume Next '<== important to prevent an infinite error loop, should the cleanup code fail.
    If Application.EnableEvents <> bInitialEnableEvents Then
        Application.EnableEvents = bInitialEnableEvents
    End If
    If Application.Calculation <> lInitialCalculation Then
        Application.Calculation = lInitialCalculation '<== back to the initial value.
    End If

    Exit Sub

ErrorHandler:
    MsgBox Err.Description, vbExclamation + vbOKOnly '<== or whatever you see fit.
    GoTo Cleanup
End Sub