運行宏會導致Excel崩潰

Question

我有一個包含約15個Excel DCT的Excel電子表格。 在該工作表上，有一個下拉菜單允許選擇用戶名，並且在更改值時，宏會使用用戶名更新電子表格中存在的所有DTC並刷新數據。 問題是，現在由於任何原因，除了在高性能計算機上，它都會使excel崩潰。 我不知道該怎么辦

這是宏：

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可能具有的不同值。

建議閱讀以下頁面，以更深入地了解所使用的資源：

在錯誤陳述中 ，

PivotCache對象（Excel） ， PivotFields對象（Excel） ， PivotItems對象（Excel）

Answer 2

我同意應刪除On Error Resume Next ，因為它將掩蓋所有導致代碼崩潰的潛在錯誤。

我還從經驗中知道，更新多個數據透視表可能會對性能造成很大的負擔，尤其是在數據源非常大的情況下。

就是說，提高此代碼性能的一種方法是將IF塊調整為每個數據透視表僅更改一次 Page Field的.CurrentPage值。 您現在擁有的方式將更改樞紐項目上每個測試的值-根據字段中項目的數量，可能要求Excel做很多事情。 換句話說，您要求Excel在每次數據透視表項不等於username時都將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