運行宏崩潰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