运行一个macros崩溃excel
我有一个Excel电子表格包含大约15个Excel DCT。 在该表中，有一个允许select用户名的下拉菜单，当更改该值时，macros将使用用户名更新电子表格中的所有DTC并刷新数据。 现在的问题是，由于任何原因，除了高性能计算机以外，它会崩溃。 我不知道该怎么办
这是macros：
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 问候，
没有必要遍历每个PivotItems ，只需将pi对象设置为所需的值并在之后进行validation即可。
也似乎你没有禁用Application.Events （在过程结束时缺lessApplication.EnableEvents = True ），如果是这样的话，那么每次更改PivotField页面时都会再次触发工作表事件， Excel崩溃的原因。
请注意，如果PivotField(strField)没有设置为PageField ，则会出现"Run-time error 1004: Unable to get the PageFields property of the PivotTable class"因此PivotField(strField)需要validation为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
此外，build议刷新PivotTables以确保您正在使用来自源数据的最新更新，还要注意PivotItem属性Value和SourceName可能具有的不同值。
build议阅读以下页面，以深入了解所使用的资源：
在错误声明上 ，
数据透视表对象（Excel） ，数据透视 表对象（Excel） ，数据透视 表对象 （Excel）
我同意On Error Resume Next应该被删除，因为它会掩盖任何可能的错误导致代码崩溃。
我也从经验中得知，更新多个数据透视表可能会对性能造成严重的负担，尤其是在数据源非常大的情况下。
也就是说，改善代码性能的一种方法是将IF块调整为只为每个PivoTable更改一次 Page字段的.CurrentPage值。 你现在拥有的方式会改变数据透视表上的每个testing的值 – 根据字段中项目的数量，这可能会让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