代码不适用于行>65536 的数据透视数据集

Code not working for Pivot Data Set having Rows>65536

我的目的是根据我拥有的转储数据 (A1:AE170000) 创建一个数据透视图 Table 和进一步的数据透视图。我在下面附上了我的代码,如果我将我的数据减少到大约 60-65k 行,它工作得很好,否则就不行。

它抛出运行时错误 13:在我设置数据透视缓存 (PTCache) 的行中键入不匹配。

Private Sub OptionButton3_Click()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    ThisWorkbook.Sheets("Data").Activate

    Dim PTCache As PivotCache
    Dim PT As PivotTable
    'Setting range as my entire data set
    Dim PTRange As Range
    Set PTRange = Range("A1", Range("A1").End(xlToRight).End(xlDown))
    'Adding a new worksheet for Pivot Table and Chart
    Dim ws As Worksheet
    Set ws = Sheets.Add
    ws.Name = "All"
    PTRange.Select
    ThisWorkbook.Sheets("All").Activate
    'Runtime error 13:Type Mismatch at this line while setting PTCache
    Set PTCache = ActiveWorkbook.PivotCaches.Create(xlDatabase, PTRange)
    Set PT = ActiveSheet.PivotTables.Add(PTCache, Range("A1"), "All")
    With PT
        .PivotFields("Name").Orientation = xlPageField
        .PivotFields("Rate").Orientation = xlDataField
        .PivotFields("Date").Orientation = xlRowField
    End With
    PT.PivotSelect ("")

    Charts.Add
    ActiveChart.Location where:=xlLocationAsObject, Name:=PT.Parent.Name
    ActiveChart.ChartType = xlLine
    ActiveChart.Parent.Top = Range("I7").Top
    ActiveChart.Parent.Left = Range("I7").Left

    Range("A2").Select
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub

来自PivotCaches.Create Method (Excel)(我强调):

<blah><blah> ... When passing as a range, it is recommended to either use a string to specify the workbook, worksheet, and cell range, or set up a named range and pass the name as a string. Passing a Range object may cause "type mismatch" errors unexpectedly.

只需为数据工作表的外部地址设置一个字符串变量 Range.CurrentRegion property 从 A1 辐射出去并使用它。

Option Explicit

Private Sub OptionButton3_Click()
    'Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    Dim PT As PivotTable, PTCache As PivotCache
    Dim PTRange As Range, ws As Worksheet, strRNG As String

    strRNG = ThisWorkbook.Worksheets("Data").Cells(1, 1).CurrentRegion.Address(external:=True)

    With Worksheets.Add(after:=Sheets(Sheets.Count))
        .Name = "All"
        Set PTCache = .Parent.PivotCaches.Create(xlDatabase, strRNG)
        Set PT = .PivotTables.Add(PTCache, .Range("A1"), "All")
        With PT
            .PivotFields("Name").Orientation = xlPageField
            .PivotFields("Rate").Orientation = xlDataField
            .PivotFields("Date").Orientation = xlRowField
        End With
        PT.PivotSelect ("")
    End With

    'all the chart stuff here

    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub