嗨,我正在尝试将公式添加到工作簿中每个工作表上的特定范围,但是当我运行它时,它不能正常工作。
公式是可以帮助计算满足特定条件的单元格数量的函数。
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
答案 0 :(得分:0)
我怀疑您的公式使用的用户定义函数会在您的代码执行时被调用,从而扰乱了循环;如果存在工作表事件事件处理程序,也可能会干扰您的循环。
在您的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