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

Question

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

我已经设置了一个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 

Answer 1

了Microsoft Jet/ACE数据库引擎的50“UNION ALL”的条款，你已经超过硬限制。唯一的办法是创建UNION ALL语句的子块，然后将它们与另一个UNION ALL一起缝合。 我演示了如何通过以下链接做到这一点：

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

你的其他选择是通过使用VBA把所有不同的工作簿到主表中的数据，然后进行数据透视出的是（根据我在http://dailydoseofexcel.com/archives/2013/11/21/unpivot-shootout/发布的时序，这将比使用SQL语句快得多），或者使用PowerQuery，这将是迄今为止最简单的方法。