Excel宏Run Time Error 5（无效过程调用）求助

问题原因 #

原代码过度依赖Select/Selection/Activate这类依赖界面选择状态的操作，很容易因工作表状态异常、选择区域无效触发错误；同时硬编码的数据范围（如$A$1:$M$500）可能与实际数据行数不匹配，导致AutoFilter参数无效，即使删除报错的Selection.AutoFilter行，后续依赖选择状态的代码仍会触发同类错误。

修复方案 #

以下是重构后的代码，核心优化点包括：

• 移除所有Select/Selection/Activate，直接引用工作表和单元格对象
• 动态计算数据范围，适配实际数据行数
• 添加工作表存在性检查，避免创建重名工作表报错
• 规范AutoFilter操作，提前判断筛选状态避免无效调用

Sub DailyInvoiceReport()
    Dim wsSource As Worksheet, wsInvoice As Worksheet, wsPivot As Worksheet
    Dim LastRow As Long, LastCol As Long
    Dim DRange As Range
    Dim pt As PivotTable
    
    ' 定义源工作表（假设当前激活表为数据源，可根据实际修改）
    Set wsSource = ActiveSheet
    
    ' 处理列显示隐藏
    wsSource.Columns("K:N").EntireColumn.Hidden = False
    wsSource.Columns("K:K,M:M").EntireColumn.Hidden = True
    
    ' 复制粘贴值
    wsSource.Cells.Copy
    wsSource.Cells.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    
    ' 添加公式并填充
    wsSource.Range("X1").FormulaR1C1 = "=IF(OR(LEFT(RC[-22],2)=""94"",LEFT(RC[-22],2)=""96""),RC[-10]*-1,RC[-10])"
    LastRow = wsSource.Cells(wsSource.Rows.Count, "B").End(xlUp).Row
    wsSource.Range("X1:X" & LastRow).FillDown
    
    ' 复制到N列并删除X列
    wsSource.Columns("X:X").Copy
    wsSource.Columns("N:N").PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
    wsSource.Columns("X:X").Delete Shift:=xlToLeft
    
    ' 删除空行（B列最后一行下方的行）
    LastRow = wsSource.Cells(wsSource.Rows.Count, "B").End(xlUp).Row
    wsSource.Rows(LastRow + 1 & ":" & wsSource.Rows.Count).Delete Shift:=xlUp
    
    ' 复制可见数据到新工作表
    wsSource.UsedRange.SpecialCells(xlCellTypeVisible).Copy
    
    ' 创建或获取"Daily Invoice"工作表
    On Error Resume Next
    Set wsInvoice = ThisWorkbook.Sheets("Daily Invoice")
    On Error GoTo 0
    If wsInvoice Is Nothing Then
        Set wsInvoice = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
        wsInvoice.Name = "Daily Invoice"
    Else
        wsInvoice.Cells.Clear ' 清空已有内容
    End If
    wsInvoice.Range("A1").PasteSpecial xlPasteAll
    Application.CutCopyMode = False
    
    ' 插入表头行并设置表头
    wsInvoice.Rows("1:1").Insert Shift:=xlDown
    With wsInvoice
        .Range("A1") = "Invoice"
        .Range("B1") = "PO#"
        .Range("C1") = "Billing creation date"
        .Range("D1") = "Customer party#"
        .Range("E1") = "Customer Party Name"
        .Range("F1") = "Method of Delivery"
        .Range("G1") = "Method of Delivery 2"
        .Range("H1") = "Term"
        .Range("I1") = "Amount"
        .Range("J1") = "Success"
        .Range("K1") = "Pending"
        .Range("L1") = "Success Amount"
        .Range("M1") = "Pending Amount"
    End With
    
    ' 应用颜色筛选并填充Success列
    LastRow = wsInvoice.Cells(wsInvoice.Rows.Count, "A").End(xlUp).Row
    With wsInvoice.Range("A1:M" & LastRow)
        ' 先移除已有筛选
        If wsInvoice.AutoFilterMode Then wsInvoice.AutoFilterMode = False
        .AutoFilter Field:=7, Criteria1:=RGB(146, 208, 80), Operator:=xlFilterCellColor
    End With
    
    wsInvoice.Range("J2:J" & LastRow).SpecialCells(xlCellTypeVisible).Value = 1
    ' 关闭筛选
    wsInvoice.AutoFilterMode = False
    
    ' 填充Pending、Success Amount、Pending Amount列公式
    With wsInvoice
        .Range("K2").FormulaR1C1 = "=IF(RC[-1]=1,0,1)"
        .Range("L2").FormulaR1C1 = "=IF(AND(RC[-2]=1,RC[-1]=0),RC[-3],0)"
        .Range("M2").FormulaR1C1 = "=IF(AND(RC[-3]=0,RC[-2]=1),RC[-4],0)"
        .Range("K2:M2").AutoFill Destination:=.Range("K2:M" & LastRow)
    End With
    
    ' 创建或获取"Pivot"工作表
    On Error Resume Next
    Set wsPivot = ThisWorkbook.Sheets("Pivot")
    On Error GoTo 0
    If wsPivot Is Nothing Then
        Set wsPivot = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
        wsPivot.Name = "Pivot"
    Else
        wsPivot.Cells.Clear ' 清空已有内容
    End If
    
    ' 创建数据透视表
    LastRow = wsInvoice.Cells(wsInvoice.Rows.Count, "A").End(xlUp).Row
    LastCol = wsInvoice.Cells(1, wsInvoice.Columns.Count).End(xlToLeft).Column
    Set DRange = wsInvoice.Cells(1, 1).Resize(LastRow, LastCol)
    
    ' 检查是否已有同名透视表，删除后重建
    On Error Resume Next
    Set pt = wsPivot.PivotTables("PivotTable2")
    On Error GoTo 0
    If Not pt Is Nothing Then pt.TableRange2.Clear
    
    Set pt = ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=DRange).CreatePivotTable( _
        TableDestination:=wsPivot.Range("A3"), TableName:="PivotTable2")
    
    ' 设置透视表字段
    With pt
        With .PivotFields("Customer Party Name")
            .Orientation = xlRowField
            .Position = 1
        End With
        With .PivotFields("Method of Delivery")
            .Orientation = xlRowField
            .Position = 2
        End With
        With .PivotFields("Term")
            .Orientation = xlRowField
            .Position = 3
        End With
        With .PivotFields("Method of Delivery 2")
            .Orientation = xlPageField
            .Position = 1
        End With
        
        ' 添加数据字段
        .AddDataField .PivotFields("Success"), "Success", xlSum
        .AddDataField .PivotFields("Pending"), "Pending", xlSum
        .CalculatedFields.Add "Total Invoice", "=Success +Pending", True
        .PivotFields("Total Invoice").Orientation = xlDataField
        
        .AddDataField .PivotFields("Success Amount"), "Success Amount", xlSum
        .AddDataField .PivotFields("Pending Amount"), "Pending Amount", xlSum
        .CalculatedFields.Add "Total Amount", "'Success Amount' +'Pending Amount'", True
        .PivotFields("Total Amount").Orientation = xlDataField
        
        ' 格式设置
        .CompactLayoutRowHeader = "Customer"
        .RowAxisLayout xlTabularRow
        .ShowDrillIndicators = False
        
        ' 取消所有字段的分类汇总
        Dim pf As PivotField
        For Each pf In .PivotFields
            pf.Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
        Next pf
    End With
    
    ' 透视表格式调整
    wsPivot.Rows("3:3").Replace What:="Sum of", Replacement:="", LookAt:=xlPart
    With wsPivot.Range("B3:I3")
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
    End With
    
    LastRow = wsPivot.Cells(wsPivot.Rows.Count, "A").End(xlUp).Row
    wsPivot.Range("E4:I" & LastRow).NumberFormat = "_(* #,##0.00_);_(* (#,##0.00);_(* ""-""??_);_(@_)"
    wsPivot.Range("E" & LastRow & ":I" & LastRow).Style = "Currency"
    
    wsPivot.Range("A1").Select
End Sub

关键修改说明 #

1. 移除选择操作：所有单元格操作直接通过工作表对象引用，彻底避免因选择状态异常导致的错误。
2. 动态范围计算：用LastRow/LastCol获取实际数据边界，替代硬编码的$A$1:$M$500，确保筛选和公式填充范围准确。
3. 工作表存在性检查：创建"Daily Invoice"和"Pivot"前先检查是否已存在，避免重名报错；若存在则清空内容后复用。
4. 规范AutoFilter操作：操作前先关闭已有筛选，避免重复调用触发错误；筛选后仅对可见区域填充值，逻辑更严谨。
5. 透视表重建处理：若已存在同名透视表，先删除再重建，避免创建失败。

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