时间戳

首页 > 解决方案 > 遍历工作簿中的所有工作表并添加公式

excel - 遍历工作簿中的所有工作表并添加公式

问题描述

您好我正在尝试将公式添加到工作簿中每个工作表的特定范围，但是当我运行时它无法正常工作。

公式是帮助计算满足特定条件的单元格数量的函数。

    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

标签： excelvba

解决方案

我怀疑您的公式使用的用户定义函数在您的代码执行时被调用，从而扰乱了循环；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

推荐阅读