运行宏崩溃excel

Question

我有一个excel电子表格，包含大约15个excel DCT。 在该表中，有一个允许选择用户名的下拉菜单，当更改该值时，宏将使用用户名更新电子表格中的所有DTC并刷新数据。 问题在于，现在出于任何原因，除高性能计算机外，它会崩溃。 我不知道该怎么办

下面是宏：

Dim pt As PivotTable 
Dim pi As PIVOTITEM 
Dim strField As String 

strField = "Cslts" 

On Error Resume Next 
'Application.EnableEvents = False 
'Application.ScreenUpdating = False 

    If Target.Address = Range("H1").Address Then 


      For Each pt In ActiveSheet.PivotTables 
       With pt.PageFields(strField) 
        For Each pi In .PivotItems 
         If pi.Value = Target.Value Then 
          .CurrentPage = Target.Value 
        Exit For 

         Else 
          .CurrentPage = "(blank)" 

         End If 
        Next pi 
       End With 
      Next pt 

    End If 

End Sub 

问候，

Answer 1

有通过每个PivotItems的无需环路，只需设置pi对象所需的值，事后验证。

它还看来你没有禁用Application.Events（通过在过程结束时缺乏Application.EnableEvents = True），如果是这样的工作表事件再次触发每次PivotField页面改变时，并且可能是原因的Excel崩溃。

注意，如果PivotField(strField)没有被设置为PageField你会得到一个因此"Run-time error 1004: Unable to get the PageFields property of the PivotTable class"的PivotField(strField)需要验证为PageField（请参见下面的代码）。

假设程序是Worksheet Change Event试试这个（参见代码中的注释）：

Private Sub Worksheet_Change(ByVal Target As Range) 
Dim pt As PivotTable 
Dim pf As PivotField 
Dim pi As PivotItem 
Dim strField As String 

    strField = "Cslts" 

    Application.EnableEvents = False 'This avoids the Worksheet event from restarting again every time the PivotTable page is changed. 
    Application.ScreenUpdating = False 

    If Target.Address = "$H$1" Then 
     For Each pt In Target.Worksheet.PivotTables 

      Rem Set PageField 
      Set pf = Nothing 
      On Error Resume Next 
      Set pf = pt.PageFields(strField) 
      On Error GoTo 0 

      Rem Validate PageField 
      If Not (pf Is Nothing) Then 
       With pf 
        .EnableMultiplePageItems = False 

        Rem Set PageField Item 
        Set pi = Nothing     'Initialize Item object 
        On Error Resume Next    'This will avoid an error if the item is not present 
        Set pi = .PivotItems(Target.Value2) 'No need to loop through the items just set the required item 
        On Error GoTo 0      'Clears the Error Object 

        Rem Validate & Set PageField Item 
        If Not (pi Is Nothing) Then 
         .CurrentPage = Target.Value2 
        Else 
         .CurrentPage = "(blank)" 

    End If: End With: End If: Next: End If 

    Application.EnableEvents = True 
    Application.ScreenUpdating = True 

    End Sub 

此外，建议刷新PivotTables，以确保您从源数据的最新更新工作，还要注意PivotItem属性Value和SourceName可能具有的不同值。

推荐阅读以下网页获得的资源有了更深的了解使用：

On Error Statement，

PivotCache Object (Excel)，PivotFields Object (Excel)，PivotItems Object (Excel)

Answer 2

我同意On Error Resume Next应该被删除，因为它会掩盖任何潜在错误导致代码崩溃。

我也从经验中知道，更新多个数据透视表可能会对性能造成严重的负担，尤其是在数据源非常大的情况下。

这就是说，一个可以提高该代码的性能的方法是通过调整IF块只能针对每个枢换一次页字段的.CurrentPage值。你现在拥有的方式会改变数据对数据库项目上的每个测试的值 - 根据字段中项目的数量，这可能会要求Excel做很多事情。换句话说，每次数据透视表项不等于用户名时，您都要求Excel手动将CurrentPage值设为空白。

重构的代码下面

Dim pt As PivotTable 
Dim pi As PivotItem 
Dim strField As String 

strField = "Cslts" 

Application.ScreenUpdating = False 

If Target.Address = Range("H1").Address Then 

    For Each pt In ActiveSheet.PivotTables 

     With pt.PageFields(strField) 

      For Each pi In .PivotItems 

       If pi.Value = Target.Value Then 

        Dim bUserNameFound 
        bUserNameFound = True 

        Exit For 

       End If 

      Next pi 

      If bUserNameFound Then 
       .CurrentPage = Target.Value 
      Else 
       .CurrentPage = "(blank)" 
      End If 

     End With 

    Next pt 

End If