导入数据的数据透视表显示全部归零

时间:2016-10-27 21:20:27

标签: vba excel-vba excel

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

       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

2 个答案:

答案 0 :(得分:0)

替换这些行:

他们尝试创建PivotTable而不是PivotCache,因此后来用于创建PivotCache的{​​{1}}为PivotTable < / em>的

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

答案 1 :(得分:0)

同时在.QueryTables.Add程序中检查此行:

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

除第一列外,所有内容都以文本形式导入或跳过。

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

enter image description here