'//我导入了一个.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
答案 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):