每当更新数据源时,worksheet_calculate都会被错误地触发

时间:2015-12-07 18:40:00

标签: excel vba excel-vba

我的工作簿主要用于统计过程控制

我有多个工作表 - WorksheetA和WorksheetB,C,D ....

WorksheetA是用户手动输入/更新新数据的地方

WorksheetB,C和其余每个包含2个数据透视表 - PivotTable1和PivotTable2。数据透视表1根据WorksheetA中的产品组过滤原始数据,并动态显示进程中的数据。然后将来自PivotTable1的数据复制到同一工作表中的其他列(例如,A列到C列)中,并且excel公式会评估是否存在任何失控情况。如果有,则显示数据的值,否则显示N / A.

由于我希望记录所有失控状态,PivotTable2会捕获A列到C列中的数据,只记录带有值的数据(这意味着它们失控)并忽略N /甲

现在,我想擅长展示一本教科书,上面写着"你有新的失控情况"只要PivotTable2有新值。在Cell D1中,我有一个总数。数据透视表2中的数据。这就是VBA的用武之地: -

1)当使用新值更新单元格D1中的计数时,文本框将自动弹出。这是代码: -

Private Sub Worksheet_Calculate()
Static countvalue
If Range("D1").Value <> countvalue Then
    countvalue = Range("D1").Value
    MsgBox "You have new out of control situation"
End If
End Sub

2)但是,为了使第一部分工作,只要输入新值,PivotTable1和PivotTable2就必须自动刷新(为了更新Cell D1计数)。因此,在WorksheetA中,我在Cell F1中有另一个数据计数,它记录了其中一列中的数据总数(让我们称之为Z列)。每当有人手动将新数据输入到Z列时,Cell F1中的计数会发生变化并触发此自动刷新公式: -

Private Sub Worksheet_Calculate()
Static autorefresh
If Range("F1").Value <> autorefresh Then
    autorefresh = Range("F1").Value
    Sheets("WorksheetB").PivotTables("PivotTable1").RefreshTable
    Sheets("WorksheetB").PivotTables("PivotTable2").RefreshTable
End If
End Sub

这两组代码运作良好。然而,我现在面临的唯一问题是,每当我保存并重新打开工作簿并在WorksheetA中输入新数据(但不在Z列中)时,即使仍未满足两个worksheet_calculate的条件,也会弹出消息框。在第一个msg框弹出后,一切都恢复正常。

如果有人能就我使用的代码向我透露一些信息,并且在错误的情况下与我一起讨论,我会很感激。我主要参考和组合各种论坛的代码。我打算在将来出现失控情况时,用自动电子邮件发送功能替换msg框。因此,如果每当有人重新打开工作簿时,worksheet_calculate函数都会自动触发,那么错误警报将一直发送到我的电子邮件中。

感谢您抽出时间阅读我的问题。我很感激。

1 个答案:

答案 0 :(得分:0)

每次重新打开工作簿后代码触发的原因是每次工作簿打开时静态变量autorefreshcountvalue重置为空,因此IF在工作簿打开后,块逻辑将始终在第一个计算结果中生成True,从而触发块内的其余行。

解决此问题的一种方法是在单独的工作表中将单元格D1的计数存储在工作表B,C ...等中。

因此,例如,如果您在工作簿的后面创建一个工作表并将其命名为reference,并将第1行设为标题行,并将WorksheetA, WorksheetB, WorksheetC, Worksheet D ...作为标题,则可以使用第2行存储每张表(cell F1 for WorksheetA, cell D1 for the rest)的计数。此外,如果您define a name存储每个值的位置,则根据工作表名称,您可以使代码更加实用和统一(请参阅下面的代码。)

然后,在您的代码中,您可以将每张纸上的当前值与最后存储的值进行比较。此外,在您的代码中,当值最终不同时,您将新值存储在相同的单元格中。

也就是说,您的WorkheetA的Worksheet_Calculate代码变为:

Private Sub Worksheet_Calculate()

If Worksheets("reference").Range(Me.Name).Value2 <> Me.Range("F1").Value2 Then
    Worksheets("reference").Range(Me.Name).Value = Range("F1").Value2
    ThisWorkbook.RefreshAll 'will refresh all pivot tables in the workbook
    'Sheets("WorksheetB").PivotTables("PivotTable1").RefreshTable
    'Sheets("WorksheetB").PivotTables("PivotTable2").RefreshTable
End If

End Sub

然后,所有其他工作表的Worksheet_Calculate代码变为:

Private Sub Worksheet_Calculate()

 If Worksheets("reference").Range(Me.Name).Value2 <> Me.Range("D1").Value2 Then
    Worksheets("reference").Range(Me.Name).Value = Me.Range("D1").Value2
    MsgBox "You have new out of control situation located in " & me.Name
End If

End Sub

最后一件事:确保在进行更改后关闭工作簿之前在reference工作表中输入值。否则,当您打开工作簿第一次时,代码将会触发,因为参考表中的值将为Null,If块将再次生成True。