使用来自89个工作簿(Excel VBA)的数据的数据透视表

我有89个Excel工作簿,每个包含2个工作表。 每张工作表代表一个加油站。 对于数据透视表,我只使用两张纸中的一张。 前排对于每一个都是相同的,但是行数是不同的 – 填充站在交付之后填充数据。 目前没有那么多数据(每张表格有37列和100行)

我已经用excel VBA代码设置了一个额外的工作簿,将所需的数据放入一个数据透视表中。

如果我不select全部89个工作簿,代码将起作用。 当我尝试select它们时,有一个错误消息说:

运行时错误“1004”:[Microsoft] [ODBC Excel驱动程序]查询太复杂

debugging显示:

设置PT = .CreatePivotTable(TableDestination:= rng(6,1))

你可以给一些提示或build议来解决这个问题吗? 非常感谢您的帮助。

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 

Microsoft JET / ACE数据库引擎有50个“UNION ALL”子句的硬限制,您已经超过了这个限制。 唯一的办法是创buildUNION ALL语句的子块,然后将它们与另一个UNION ALL拼接在一起。 我演示了如何在以下链接执行此操作:

http://dailydoseofexcel.com/archives/2013/11/19/unpivot-via-sql/

您的其他选项是使用VBA将来自所有不同工作簿的数据转换为主表单,然后创build一个可转换表(这将比使用SQL语句要快得多,因为我发布在http:// dailydoseofexcel .com / archives / 2013/11/21 / unpivot-shootout / )或使用PowerQuery,这将是迄今为止最简单的方法。