2017-04-26 47 views
0

我有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 
+0

請檢查您的'PC'是否有'SourceData'添加一行'Debug.Print PC.SourceData' –

回答

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,這將是迄今爲止最簡單的方法。

相關問題