多功能呼叫 - 公共子

Question

我正在尝试让我的Public Sub对两个函数进行调用，每个函数都从同一数据表创建不同的数据透视表。我知道我的两个函数都是独立工作的，但我一直在定义一个＆34;应用程序定义错误＆＃34;当我把它们组合成一个子。

下面的宏会执行第一个函数并创建预期的数据透视表。它只是在到达第二个函数时停止并向我提供上面提到的应用程序或对象定义的错误。我已经独立定义了每个功能，所以我不确定为什么我会遇到问题。

Option Explicit

Public Sub RunPivots()
Call BuildPivot1("Travel Payment Data by Employee")
Call BuildPivot2("Travel Payment Data by Acct Dim")

End Sub

Function BuildPivot1(paramSheet As String)
On Error GoTo ErrHandle
Dim FinalRow            As Long
Dim DataSheet           As String
Dim PvtCache            As PivotCache
Dim PvtTbl              As PivotTable
Dim PvtFld              As PivotField
Dim DataRng             As Range
Dim TableDest           As Range
Dim ws                  As Worksheet

 For Each ws In ThisWorkbook.Sheets
    If ws.Name Like "*SQL" & "*" Then
        '~~> This check is required to ensure that you don't get an error
        '~~> if there is only one sheet left and it matches the delete criteria
        If ThisWorkbook.Sheets.Count = 1 Then
            MsgBox "There is only one sheet left and you cannot delete it"
        Else
            '~~> This is required to supress the dialog box which excel shows
            '~~> When you delete a sheet. Remove it if you want to see the
            '~~~> Dialog Box
            Application.DisplayAlerts = False
            ws.Delete
            Application.DisplayAlerts = True
        End If
    End If
Next

FinalRow = Cells(Rows.Count, 1).End(xlUp).Row

DataSheet = "Export Worksheet"
' set data range for Pivot Table
 Set DataRng = Sheets(DataSheet).Range(Cells(1, 1), Cells(FinalRow, 15))

' check if worksheet exists
Dim currws As Worksheet
For Each currws In ActiveWorkbook.Worksheets
    If currws.Name = paramSheet Then
        Set ws = Worksheets(paramSheet)
        Exit For
    End If
Next currws

' create new worksheet if does not exist
If ws Is Nothing Then
    Set ws = Worksheets.Add
    ws.Name = paramSheet
End If

' set range for Pivot table placement
Set TableDest = Sheets(paramSheet).Cells(1, 1)

' create pivot cache
Set PvtCache = ActiveWorkbook.PivotCaches.Create( _
          SourceType:=xlDatabase, _
          SourceData:=DataRng, _
          Version:=xlPivotTableVersion15)

'check if "PivotTable4" Pivot Table exists
Dim currpvt As PivotTable
For Each currpvt In ws.PivotTables
    If currpvt.Name = "PivotTable4" Then
        Set PvtTbl = ws.PivotTables("PivotTable4")
        Exit For
    End If
Next currpvt

' create new pivot table if does not exist
If PvtTbl Is Nothing Then
    Set PvtTbl = PvtCache.CreatePivotTable( _
        TableDestination:=TableDest, _
        TableName:="PivotTable4")
End If

With PvtTbl.PivotFields("Security Org")
    .Orientation = xlRowField
    .Position = 1
End With
With PvtTbl.PivotFields("Fiscal Month")
    .Orientation = xlRowField
    .Position = 2
End With
With PvtTbl.PivotFields("Budget Org")
    .Orientation = xlRowField
    .Position = 3
End With
With PvtTbl.PivotFields("Vendor Name")
    .Orientation = xlRowField
    .Position = 4
End With
With PvtTbl.PivotFields("Fiscal Year")
    .Orientation = xlRowField
    .Position = 5
End With
With PvtTbl.PivotFields("Fiscal Year")
    .Orientation = xlColumnField
    .Position = 1
End With

Range("B:E").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.NumberFormat = "$#,##0.00"
Range("B1").Select
PvtTbl.CompactLayoutColumnHeader = _
    "Fiscal Year"
Range("A2").Select
PvtTbl.CompactLayoutRowHeader = _
    "Security Org and Vendor"
Range("G8").Select

' Add data field if does not exist
On Error Resume Next
PvtTbl.AddDataField PvtTbl.PivotFields("Dollar Amount"), "Sum of Dollar Amount", xlSum
PvtTbl.PivotFields("Budget Org").ShowDetail = _
    False
Exit Function

ErrHandle:
MsgBox Err.Number & " - " & Err.Description, vbCritical, "RUNTIME ERROR"
Exit Function
End Function

Function BuildPivot2(paramSheet As String)
On Error GoTo ErrHandle
Dim FinalRow            As Long
Dim DataSheet           As String
Dim PvtCache            As PivotCache
Dim PvtTbl              As PivotTable
Dim PvtFld              As PivotField
Dim DataRng             As Range
Dim TableDest           As Range
Dim ws                  As Worksheet

 For Each ws In ThisWorkbook.Sheets
    If ws.Name Like "*SQL" & "*" Then
        '~~> This check is required to ensure that you don't get an error
        '~~> if there is only one sheet left and it matches the delete criteria
        If ThisWorkbook.Sheets.Count = 1 Then
            MsgBox "There is only one sheet left and you cannot delete it"
        Else
            '~~> This is required to supress the dialog box which excel shows
            '~~> When you delete a sheet. Remove it if you want to see the
            '~~~> Dialog Box
            Application.DisplayAlerts = False
            ws.Delete
            Application.DisplayAlerts = True
        End If
    End If
Next

FinalRow = Cells(Rows.Count, 1).End(xlUp).Row

DataSheet = "Export Worksheet"
' set data range for Pivot Table
DataSheet = "Export Worksheet"
' set data range for Pivot Table
With Sheets(DataSheet)
    Set DataRng = .Range(Cells(1, 1), .Cells(FinalRow, 15))
End With

' check if worksheet exists
Dim currws As Worksheet
For Each currws In ActiveWorkbook.Worksheets
    If currws.Name = paramSheet Then
        Set ws = Worksheets(paramSheet)
        Exit For
    End If
Next currws

' create new worksheet if does not exist
If ws Is Nothing Then
    Set ws = Worksheets.Add
    ws.Name = paramSheet
End If

' set range for Pivot table placement
Set TableDest = Sheets(paramSheet).Cells(1, 1)

' create pivot cache
Set PvtCache = ActiveWorkbook.PivotCaches.Create( _
          SourceType:=xlDatabase, _
          SourceData:=DataRng, _
          Version:=xlPivotTableVersion15)

'check if "PivotTable4" Pivot Table exists
Dim currpvt As PivotTable
For Each currpvt In ws.PivotTables
    If currpvt.Name = "PivotTable4" Then
        Set PvtTbl = ws.PivotTables("PivotTable4")
        Exit For
    End If
Next currpvt

' create new pivot table if does not exist
If PvtTbl Is Nothing Then
    Set PvtTbl = PvtCache.CreatePivotTable( _
        TableDestination:=TableDest, _
        TableName:="PivotTable4")
End If

With PvtTbl.PivotFields("Fiscal Year")
    .Orientation = xlColumnField
    .Position = 1
End With
With PvtTbl.PivotFields("Fund")
    .Orientation = xlRowField
    .Position = 1
End With
With PvtTbl.PivotFields("Budget Org")
    .Orientation = xlRowField
    .Position = 2
End With
With PvtTbl.PivotFields("Cost Org")
    .Orientation = xlRowField
    .Position = 3
End With

Range("B:E").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.NumberFormat = "$#,##0.00"
Range("B1").Select
PvtTbl.CompactLayoutColumnHeader = _
    "Fiscal Year"
Range("A2").Select
PvtTbl.CompactLayoutRowHeader = _
    "Security Org and Vendor"
Range("G8").Select

' Add data field if does not exist
On Error Resume Next
PvtTbl.AddDataField PvtTbl.PivotFields("Dollar Amount"), "Sum of Dollar Amount", xlSum
PvtTbl.PivotFields("Budget Org").ShowDetail = _
    False
Exit Function

ErrHandle:
MsgBox Err.Number & " - " & Err.Description, vbCritical, "RUNTIME ERROR"
Exit Function

End Function

Answer 1

您需要确保使用工作表对象限定所有Cells（）和Range（）调用。例如：

Set DataRng = Sheets(DataSheet).Range(Cells(1, 1), Cells(FinalRow, 15))

如果DataSheet工作表不是活动表，

将失败。

像这样修复：

With Sheets(DataSheet)
    Set DataRng = .Range(.Cells(1, 1), .Cells(FinalRow, 15))
End With