Excel 使用VBA创建透视图，导致运行时5错误

我正在尝试通过VBA创建透视图（这样按钮就可以基于表单中的动态值创建饼图）

我的代码是：

 Dim iRow As Long


    '//Find First Empty Row In Database
iRow = Sheets("search results").Cells.Find(What:="*", SearchOrder:=xlRows, _
    SearchDirection:=xlPrevious, LookIn:=xlValues).Row

    Sheets("Custom Chart").visible = True
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "Search Results!A3:AM" & iRow, Version:=xlPivotTableVersion14). _
        CreatePivotTable TableDestination:="Custom Chart!A1", TableName:="PivotTable6" _
        , DefaultVersion:=xlPivotTableVersion14
    Sheets("Custom Chart").Select
    Cells(1, 1).Select
    ActiveSheet.Shapes.AddChart.Select
    ActiveChart.ChartType = xlColumnClustered
    ActiveChart.SetSourceData Source:=Range("Custom Chart!$A$1:$C$18")
    ActiveSheet.Shapes("Chart 1").IncrementLeft 192
    ActiveSheet.Shapes("Chart 1").IncrementTop 15
    ActiveSheet.PivotTables("PivotTable6").AddDataField ActiveSheet.PivotTables( _
        "PivotTable6").PivotFields("Ethnicity Of Child"), "Count of Ethnicity Of Child" _
        , xlCount
    With ActiveSheet.PivotTables("PivotTable6").PivotFields(Me.Dy4.Value)
        .Orientation = xlRowField
        .Position = 1
    End With
    ActiveChart.ChartType = xlPie
    ActiveChart.ApplyLayout (6)
    ActiveChart.Location Where:=xlLocationAsNewSheet, Name:="Chart Result"
    ActiveWorkbook.ShowPivotTableFieldList = False

我的代码在此行失败：

ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
    "Search Results!A3:AM" & iRow, Version:=xlPivotTableVersion14). _
    CreatePivotTable TableDestination:="Custom Chart!A1", TableName:="PivotTable6" _
    , DefaultVersion:=xlPivotTableVersion14

表示发生了运行时5错误。我能想到的唯一原因是我试图使用单元格引用来定义一个范围，我注意到如果你记录创建一个透视图，它会使用范围，比如

Sheet1！R1C1

，但我不理解这些参考资料

任何帮助都将不胜感激

---

提前谢谢。

我自己解决了这个问题

以下是生成带变量表单图表的完整代码：

Private Sub Creat_Chart_Click()

Worksheets.Add().Name = "Custom Chart"

If Me.R_End.Value = "" Or _
Me.R_Start.Value = "" Or _
Me.Chart_List.Value = "" Or _
Me.Data_List.Value = "" Or _
Me.Dy2.Value = "" Or _
Me.Dy4.Value = "" Then

MsgBox "Information is missing from the form"

Exit Sub

End If




Dim ws As Worksheet

Set ws = Worksheets("database")

Sheets("Settings").Range("Start_Date").Value = Format(Me.R_Start.Value, "mm/dd/yyyy")
Sheets("Settings").Range("End_Date").Value = Format(Me.R_End.Value, "mm/dd/yyyy")

'Collect Start & End Dates
Dim dStartDate As Long
Dim dEndDate As Long
dStartDate = Sheets("Settings").Range("Start_Date").Value
dEndDate = Sheets("Settings").Range("End_Date").Value

ws.Activate

'On Error GoTo error_Sdate:

    RowNum = Application.WorksheetFunction.Match(dStartDate, Range("B1:B60000"), 0)
    ' MsgBox "Found " & Format(dStartDate, "dd/mm/yyyy") & " at row : " & RowNum

'On Error GoTo error_Edate:

    RowNumEnd = Application.WorksheetFunction.Match(dEndDate, Range("B1:B60000"), 1)
    ' MsgBox "Found " & Format(dEndDate, "dd/mm/yyyy") & " at row : " & RowNumEnd

GoTo J1

error_Sdate:

Dim msg As String

msg = "You entered " & Format(dStartDate, "dd/mm/yyyy") & " as your Start Date, but no referrals were made on that date"
msg = msg & vbCrLf & "Please enter a different date in the Start Date box"
MsgBox msg, , "Start Date Not Found"
Err.Clear
Exit Sub

error_Edate:
msg = "You entered " & Format(dEndDate, "dd/mm/yyyy") & " as your End Date, but no referrals were made on that date"
msg = msg & vbCrLf & "Please enter a different date in the End Date box"
MsgBox msg, , "End Date Not Found"
Err.Clear
Exit Sub


J1:

Dim CR_1 As Integer
Dim CR1 As Integer

'// Get Criteria From Form And Search Database Headers
If Me.Data_List.Value = "Display Variable By Agency Of Referrer" Then

CR1 = 3

End If

If Me.Data_List.Value = "Display Variable By Agency Of Allegee" Then

CR1 = 4

End If



Set ws = Worksheets("database")
Set ps = Worksheets("Search Results")

   ps.Range("A3:AM60000").Clear

'Dim RowNum As Variant
'Dim RowNumEnd As Variant

    For i = RowNum To RowNumEnd
        If ws.Cells(i, CR1).Value = Me.Dy2.Value Then
        ws.Range("A" & i & ":AM" & i).Copy

        ps.Activate
        'find first empty row in database
        emR = ps.Cells.Find(What:="*", SearchOrder:=xlRows, _
        SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1
        ps.Range("A" & emR & ":AM" & emR).PasteSpecial

    End If
    Next i


Dim wksSource As Worksheet
    Dim wksDest As Worksheet
    Dim rngSource As Range
    Dim rngDest As Range
    Dim LastRow As Long
    Dim LastCol As Long

    Set wksSource = Worksheets("Search Results")

    Set wksDest = Worksheets("Custom Chart")

    With wksSource
        LastRow = .Range("A2").End(xlDown).Row
        LastCol = .Range("A2").End(xlToRight).Column
        Set rngSource = .Range("A2", .Cells(LastRow, LastCol))
    End With

    Set rngDest = wksDest.Range("A1")


wksDest.Activate

'    If wksDest.PivotTables.count > 0 Then
'
'
'    wksDest.Range("A:Z").Delete
'
'
'    End If



       ActiveSheet.PivotTableWizard _
        SourceType:=xlDatabase, _
        SourceData:=rngSource, _
        TableDestination:=rngDest, _
        TableName:="Pivotinfo"

    With wksDest.PivotTables("Pivotinfo")
        .PivotFields(Me.Dy4.Value).Orientation = xlRowField
        .PivotFields(Me.Dy4.Value).Orientation = xlDataField
    End With

  Dim CC As Worksheet
  Dim CCR, CCC As Long

 Set CC = Sheets("Custom Chart")


  CCR = CC.Cells.Find(What:="*", SearchOrder:=xlRows, _
        SearchDirection:=xlPrevious, LookIn:=xlValues).Row
  CCC = CC.Cells.Find(What:="*", SearchOrder:=xlRows, _
        SearchDirection:=xlPrevious, LookIn:=xlValues).Column

            Range("A1").Select
    ActiveWorkbook.Charts.Add
    ActiveChart.ChartType = xlPie
    ActiveChart.ApplyLayout (4)
    ActiveChart.SetElement (msoElementChartTitleAboveChart)
    ActiveChart.SetElement (msoElementLegendRight)
    ActiveChart.ApplyDataLabels
    ActiveChart.SeriesCollection(1).DataLabels.Select
    Selection.ShowPercentage = True
    Selection.ShowCategoryName = False
    Selection.Separator = "" & Chr(10) & ""
    If CR1 = 3 Then

    ActiveChart.ChartTitle.Characters.Text = Me.Dy4.Value & " Referred By " & Me.Dy2.Value & _
    " Between The Dates " & Me.R_Start.Value & " & " & Me.R_End.Value

    End If

    If CR1 = 4 Then

    ActiveChart.ChartTitle.Characters.Text = Me.Dy4.Value & " Referred By " & Me.Dy2.Value & _
    " Between The Dates " & Me.R_Start.Value & " & " & Me.R_End.Value

    End If




    Application.DisplayAlerts = False
    Worksheets("Custom Chart").Delete
    Application.DisplayAlerts = True

End Sub

---

我通过删除自定义图表表并重新创建它来摆脱透视表，这样我就可以用相同的名称创建一个新的透视表，从而解决了这个问题。虽然不是最整洁的方法，但它很有效。

iRow是Long类型，您正在尝试将其添加到字符串中。您需要将

iRow

替换为

CStr（iRow）

。还可以查看此主题。@DeanBDean不幸的是，您建议使用

CStr（iRow）

并不能解决此问题。另外，在其他地方，我将iRow定义为long，并以相同的方式使用它，没有问题。我相信您的问题在TableDestination:=“Custom Chart！A1”上。当我用范围对象替换“Custom Chart！A1”时，我遇到了运行时5错误。在创建数据透视表的行之前，添加

Dim pivotDest as Range

。然后在下一行中添加

Set pivotDest=ActiveWorkbook.Sheets（“自定义图表”）.Range（“A1”）

。然后将

“自定义图表！A1”

替换为

pivotDest