导入数据上的透视表，显示全部为零

Question

‘//我导入了一个.csv文件，然后对导入的数据应用了透视表，但问题是我在透视表中得到了全零。(全部使用'vba)).Want帮助//

       Sub RRCJABO()

        On Error Resume Next
        Application.DisplayAlerts = False
        Worksheets("Sheet2").Delete


        'Importing data to sheet2


        Sheets.Add Before:=ActiveSheet
        ActiveSheet.Name = "Sheet2"
        Worksheets("Sheet2").Activate
        With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;" & GetFile, Destination:=Range( _
        "$A$1"))
        .Name = "logexportdata"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 437
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(5, 2, 2, 2, 2, 2, 9, 9, 9, 9, 9)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
        End With


        'Inserting a blank Column at Column B

        Range("B1").EntireColumn.Insert
        Worksheets("Sheet2").Activate


        'Extracting Date from DateTime

        Cells(2, 2).Value = "=INT(A2)"
        Dim LastRowA As Long
        Dim LastRowB As Long
        LastRowA = Range("A" & Rows.Count).End(xlUp).Row
        LastRowB = Range("B" & Rows.Count).End(xlUp).Row
        Range("B2").AutoFill Destination:=Range("B2:B" & LastRowA),`Type:=xlFillDefault                            `
        Range("A2:A" & LastRowA).Value = Range("B2:B" & LastRowB)
        Columns(2).EntireColumn.Delete


        'Insert pivot table (calling pivot table procedure inside mai procedure) 

        pivotpmpdcp


       End Sub

Function GetFile() As String
    Dim filename__path As Variant
    filename__path = Application.GetOpenFilename(FileFilter:="Csv (*.CSV), *.CSV", Title:="Select File To Be Opened")
    If filename__path = False Then Exit Function
    GetFile = filename__path
End Function

Sub pivotpmpdcp()

    'Declare Variables

    Dim PSheet As Worksheet
    Dim DSheet As Worksheet
    Dim PCache As PivotCache
    Dim PTable As pivottable
    Dim PRange As Range
    Dim LastRow As Long
    Dim LastCol As Long


    'Delete Preivous Pivot Table Worksheet & Insert a New Blank Worksheet With Same Name

    On Error Resume Next
    Application.DisplayAlerts = False
    Worksheets("pmpdcp").Delete
    Sheets.Add Before:=ActiveSheet
    ActiveSheet.Name = "pmpdcp"
    Application.DisplayAlerts = True
    Set PSheet = Worksheets("pmpdcp")
    Set DSheet = Worksheets("Sheet2")


    'Define Data Range

    LastRow = DSheet.Cells(Rows.Count, 1).End(xlUp).Row
    LastCol = DSheet.Cells(1, Columns.Count).End(xlToLeft).Column
    Set PRange = DSheet.Cells(1, 1).Resize(LastRow, LastCol)



    'Define Pivot Cache

    Set PCache = ActiveWorkbook.PivotCaches.Create _
    (SourceType:=xlDatabase, SourceData:=PRange). _
    CreatePivotTable(TableDestination:=PSheet.Cells(4, 4), _
    TableName:="pivotpmpdcp")


    'Insert Blank Pivot Table

    Set PTable = PCache.CreatePivotTable _
    (TableDestination:=PSheet.Cells(3, 3), TableName:="pivotpmpdcp")


    'Insert Row Fields

    With ActiveSheet.PivotTables("pivotpmpdcp").PivotFields("Object")
     .Orientation = xlRowField
     .Position = 1
    End With


    'Insert Column Fields

    With ActiveSheet.PivotTables("pivotpmpdcp").PivotFields("Time")
     .Orientation = xlColumnField
     .Position = 1
    End With


    'Insert Data Field1

    With `ActiveSheet.PivotTables("pivotpmpdcp").PivotFields("EUtranCellFDD.pmPdcpBitrateDlDrbMax")`
     .Orientation = xlDataField
     .Position = 1
     .Function = xlMax
     .NumberFormat = "#,##0"
     .Name = "EUtranCellFDD.pmPdcpBitrateDlDrbMax"
    End With

End Sub

Answer 1

替换这些行：

它们尝试创建PivotTable而不是PivotCache__，因此后来用于创建PivotTable的PivotCache是Nothing

'Define Pivot Cache
Set PCache = ActiveWorkbook.PivotCaches.Create _
    (SourceType:=xlDatabase, SourceData:=PRange). _
    CreatePivotTable(TableDestination:=PSheet.Cells(4, 4), _
    TableName:="pivotpmpdcp")

有了这些：

'Define Pivot Cache
Set PCache = ActiveWorkbook.PivotCaches _
    .Create(SourceType:=xlDatabase, SourceData:=PRange)

由于以下各项的使用效率低下，因此未提示此错误：

On Error Resume Next
Worksheets("Sheet2").Delete

在第一个程序开始时。ON Error Resume Next禁用错误提示。

On Error Resume用于绕过错误提示，以防Sheet2在代码尝试删除它时不存在，但是应该在获得所需效果后立即使用On Error Goto 0重新声明，如下所示。

On Error Resume Next
Worksheets("Sheet2").Delete
On Error GoTo 0

建议阅读以下页面，以更深入地了解所使用的资源：On Error Statement

Answer 2

还要检查.QueryTables.Add过程中的这一行：

.TextFileColumnDataTypes = Array(5, 2, 2, 2, 2, 2, 9, 9, 9, 9, 9)

除第一列外的所有内容都作为文本导入或跳过。

使用此表作为参考，并查看此QueryTable.TextFileColumnDataTypes Property (Excel)

​

​