VBA循环报错处理及PivotTable3匹配逻辑调整求助

Hey there, let's tackle your VBA code issues step by step. I see two main problems: the loop is throwing errors, and you need to skip cells where the value doesn't exist in your PivotTable's RootCause field. Here's a revised version of your code that fixes both, plus some stability and efficiency improvements:

Sub FILL_vALUES_EXO()
    Dim wsEXO As Worksheet
    Dim wsPivot As Worksheet
    Dim pt As PivotTable
    Dim pf As PivotField
    Dim lastRow As Long
    Dim targetRange As Range
    Dim y As Long
    
    ' Set explicit references to avoid relying on ActiveSheet
    Set wsEXO = ThisWorkbook.Worksheets("EXO")
    Set wsPivot = ActiveSheet ' Replace with your pivot sheet name (e.g., ThisWorkbook.Worksheets("PivotSheet")) if known
    Set pt = wsPivot.PivotTables("PivotTable3")
    Set pf = pt.PivotFields("RootCause")
    
    y = 9 ' Start at row 9 per your original code
    
    ' Loop through rows 9 to 67 in column N
    Do While y <= 67
        ' Skip empty cells in column N immediately
        If wsEXO.Range("N" & y).Value = "" Then
            y = y + 1
            GoTo NextIteration
        End If
        
        Application.CutCopyMode = False
        
        ' Handle errors when setting pivot filter (for unmatched values)
        On Error Resume Next
        pf.ClearAllFilters
        pf.CurrentPage = wsEXO.Range("N" & y).Value
        
        ' If an error occurred (value not found in pivot), skip to next cell
        If Err.Number <> 0 Then
            On Error GoTo 0 ' Reset error handling
            y = y + 1
            GoTo NextIteration
        End If
        On Error GoTo 0 ' Reset error handling
        
        ' Dynamically find the last row/column in the pivot data range
        lastRow = wsPivot.Cells(wsPivot.Rows.Count, "B").End(xlUp).Row
        Set targetRange = wsPivot.Range(wsPivot.Range("B6"), wsPivot.Cells(lastRow, wsPivot.Cells(6, wsPivot.Columns.Count).End(xlToLeft).Column))
        
        ' Copy pivot data to EXO sheet (no Select needed!)
        targetRange.Copy wsEXO.Range("O" & y)
        
        ' Copy formats from O4 to the target row
        wsEXO.Range("O4").Copy
        wsEXO.Range("O" & y & ":R" & y).PasteSpecial Paste:=xlPasteFormats
        
        Application.CutCopyMode = False
        
NextIteration:
        y = y + 1
    Loop
End Sub

Key Fixes & Improvements: #

• Error Handling for Unmatched Values: We use On Error Resume Next to catch the error that pops up when trying to set a pivot filter to a value that doesn't exist. If an error is detected, we skip the current cell and move to the next one.
• Removed Select/Selection: Relying on these is unstable (it depends on what's active) and slow. We directly reference ranges and objects instead for more reliable code.
• Fixed Loop Logic: Instead of using a counter i with CountA, we loop directly through rows 9 to 67, skipping empty cells in column N. This avoids mismatches between the count of non-empty cells and your row index y.
• Explicit Object References: We define variables for worksheets, the pivot table, and pivot field to make the code clearer and less prone to bugs.
• Dynamic Range Selection: The code automatically finds the last used row and column in the pivot table, so it works even if your pivot data grows or shrinks.

Extra Tips: #

• If you know the exact name of your pivot sheet, replace Set wsPivot = ActiveSheet with something like Set wsPivot = ThisWorkbook.Worksheets("PivotData") to make the code even more reliable.
• Add Application.ScreenUpdating = False at the start of the sub and Application.ScreenUpdating = True at the end to speed up execution (especially with large datasets).

内容的提问来源于stack exchange，提问作者Salim