循环浏览工作簿中的所有工作表并添加公式

时间:2018-11-13 02:04:19

标签: excel vba excel-vba

嗨,我正在尝试将公式添加到工作簿中每个工作表上的特定范围,但是当我运行它时,它不能正常工作。

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

    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

1 个答案:

答案 0 :(得分:0)

我怀疑您的公式使用的用户定义函数会在您的代码执行时被调用,从而扰乱了循环;如果存在工作表事件事件处理程序,也可能会干扰您的循环。

在您的Formatting子目录中,将For循环夹在Application.CalculationApplication.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