更新自动过滤器oncellchange时Excel崩溃

Question

我使用以下代码在单元格更改时刷新Excel中的自动过滤器。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim MySheet As Worksheet
  'On Error Resume Next
  'Set MySheet = Application.ActiveSheet
  'MySheet.Columns(1).AutoFilter.ApplyFilter
  'On Error Resume Next
  'Application.EnableEvents = False
  Worksheets("Basisgegevens").Range("$A$1:$A$146").AutoFilter Field:=1, Criteria1:=Array("0", _
        "2", "="), Operator:=xlFilterValues
  'Application.EnableEvents = True
  'On Error GoTo 0
End Sub

我使用它来根据特定条件隐藏行。 为此，它的效果非常好。

问题
但是，当我在单元格上设置验证并添加其中一个很酷的下拉列表时。
要让单元格看起来像这样：

该部分工作正常，但只要我选择一个不同的值，导致自动过滤器隐藏/显示不同的单元格 excel崩溃

我的理论
验证下拉列表会更改单元格 这会触发上面显示的VBA代码 但是，验证代码仍在运行，而过滤器设置将重新初始化 这会导致Excel崩溃。

我该如何解决这个问题？
运行VBA活动会以某种方式延迟帮助吗？ 我怎么做？

Answer 1

我认为你现在所做的事情没有任何问题。但我怀疑还有另一个组件导致这种崩溃，例如addins。为什么不卸载或删除不必要的插件（http://office.microsoft.com/en-us/excel-help/load-or-unload-add-in-programs-HP010096834.aspx）并再次尝试代码？

Answer 2

看起来像竞赛条件，如果在计算完成之前重新应用过滤器，则会导致Excel崩溃。
这确实需要一张大纸张，因此计算需要足够长的时间才能完成。

以下是解决方法：

Option Explicit

Dim ReapplyFilter As Boolean

'OnCalculate is always called twice, before and after calculation.
'I'm only interested in the event after.  
Private Sub Worksheet_Calculate()
  If (Application.CalculationState = xlDone) And (ReapplyFilter = True) Then
    ReapplyFilter = False
    On Error Resume Next
    Worksheets("Basisgegevens").Range("$A$1:$A$146").AutoFilter Field:=1, Criteria1:=Array("0", _
          "2", "3", "4", "5", "="), Operator:=xlFilterValues
    On Error GoTo 0
  End If

End Sub

'Always Reapply the filter on activation of the sheet.
Private Sub Worksheet_Activate()
  Worksheets("Basisgegevens").Range("$A$1:$A$146").AutoFilter Field:=1, Criteria1:=Array("0", _
          "2", "3", "4", "5", "="), Operator:=xlFilterValues
End Sub

'OnChange: set the flag to be picked up by calculation later on.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim MySheet As Worksheet
  ReapplyFilter = True
End Sub