我有89個excel工作簿,每個工作簿包含2個工作表。每張工作表代表一個加油站。 對於數據透視表,我只使用兩張紙中的一張。前排對於每一個都是相同的,但是行數不同 - 填充站在交付後填充數據。 目前沒有那麼多的數據(每個表中有37列和100行)使用來自89個工作簿(Excel VBA)的數據的數據透視表
我已經設置了一個Excel工作簿,用於將所需數據拖入一個數據透視表。
如果我不選擇全部89個工作簿,代碼將起作用。 當我嘗試選擇所有的人,有一個錯誤消息,指出:
運行時錯誤「1004」:[微軟] [ODBC Excel驅動程序]查詢是太複雜
調試顯示:
集PT = .CreatePivotTable(TableDestination:= RNG(6,1))
能否請您給一些TI ps或建議來解決問題? 非常感謝您的幫助。
Option Explicit
Declare Function SetCurrentDirectoryA Lib "kernel32" (ByVal Path As String) As Long
Sub ChDirNet(Path As String)
Dim Result As Long
Result = SetCurrentDirectoryA(Path)
If Result = 0 Then Err.Raise vbObjectError + 1, "Error changing to new path."
End Sub
Sub MergeFiles()
Dim PT As PivotTable
Dim PC As PivotCache
Dim arrFiles As Variant
Dim strSheet As String
Dim strPath As String
Dim strSQL As String
Dim strCon As String
Dim rng As Range
Dim i As Long
strPath = CurDir
ChDirNet ThisWorkbook.Path
arrFiles = Application.GetOpenFilename("Microsoft Excel Macro-Enabled Worksheet (*.xlsm), *.xlsm", , , , True)
strSheet = "DB"
If Not IsArray(arrFiles) Then Exit Sub
Application.ScreenUpdating = False
If Val(Application.Version) > 11 Then DeleteConnections_12
Set rng = ThisWorkbook.Sheets(1).Cells
rng.Clear
For i = 1 To UBound(arrFiles)
If strSQL = "" Then
strSQL = "SELECT * FROM [" & strSheet & "$]"
Else
strSQL = strSQL & " UNION ALL SELECT * FROM `" & arrFiles(i) & "`.[" & strSheet & "$]"
End If
Next i
strCon = _
"ODBC;" & _
"DSN=Excel Files;" & _
"DBQ=" & arrFiles(1) & ";" & _
"DefaultDir=" & "" & ";" & _
"Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};" & _
"DriverId=1046;" & _
"MaxBufferSize=2048;" & _
"PageTimeout=5"
Set PC = ThisWorkbook.PivotCaches.Add(SourceType:=xlExternal)
With PC
.Connection = strCon
.CommandType = xlCmdSql
.CommandText = strSQL
Set PT = .CreatePivotTable(TableDestination:=rng(6, 1))
End With
With PT
With .PivotFields(1) 'Date
.Orientation = xlRowField
.Position = 1
End With
With .PivotFields(2) 'Product
.Orientation = xlRowField
.Position = 2
End With
.AddDataField .PivotFields(32), "Manko", xlSum 'Difference N/V L15
.AddDataField .PivotFields(9), "Sum of Dodané", xlSum 'Delivery L15
With .PivotFields(16) 'SPZ
.Orientation = xlPageField
.Position = 1
End With
With .PivotFields(18) 'supply
.Orientation = xlPageField
.Position = 2
End With
With .PivotFields(37) 'Number of FS
.Orientation = xlColumnField
.Position = 1
End With
End With
'Clean up
Set PT = Nothing
Set PC = Nothing
ChDirNet strPath
Application.ScreenUpdating = True
End Sub
Private Sub DeleteConnections_12()
'*****************************************************************************
On Error Resume Next: ThisWorkbook.Connections(1).Delete: On Error GoTo 0
'*****************************************************************************
End Sub
請檢查您的'PC'是否有'SourceData'添加一行'Debug.Print PC.SourceData' –