使用MS Access交叉表查詢時出現太多交叉表列標題錯誤

Question

我試圖導出MS-Access交叉表查詢，但得到錯誤消息「太多的交叉表列標題」。

事實證明，MS-Access有一個極限到列的查詢可以具有（255列）的數目。

經過一些在線搜索後，我沒有遇到任何可行的解決方案...... 一個解決方案是將查詢拆分成多個列少於255列的查詢，但是您需要創建多個查詢，這取決於數量列，這可能是未知的。這不是一項非常簡單的任務。

有沒有辦法將具有超過255列的交叉表查詢導出到Excel文件中？更具體地說：有沒有使用VBA代碼的解決方案？

Answer 1

我建議的解決方案是將查詢用作普通（非交叉表）查詢，將其導出到excel文件，然後在文件中創建一個「透視表」（與交叉表相同）。這可以手動完成，但我想使用代碼將其自動化。

我寫了這個VBA子，其中一個給定的MS-Access查詢輸出到Excel文件，並將其操縱至樞軸表（具有255分以上的列！）：

Sub export_query_to_pivot(query_name As String, folder_name As String, file_name As String) 

    ' Outputs the query to an excel file in the chosen path, and creates a pivot table 
    If folder_name <> "" Then 

     MsgBox "Exporting begins! Do not open the file until a message appears" 

     ' Output the query to excel file 
     DoCmd.OutputTo acOutputQuery, query_name, acFormatXLSX, folder_name & file_name 

     ' --------- Manipulate the excel file to create a pivot table using code 
     ' Using a mechanism called "Late-Binding" to handle the excel file (notice we define it as an "Object", and then set the object type) 
     Dim excel_object As Object 
     Dim work_book As Object 
     Dim src_sheet As Object 
     Dim pivot_sheet As Object 
     Dim last_row As Long 
     Dim last_column As Long 

     Set excel_object = CreateObject("Excel.Application") ' Instantiate the Excel instance 
     Set work_book = excel_object.Workbooks.Open(folder_name & file_name) ' Open the workbook 
     Set src_sheet = work_book.Sheets(1) ' Set the source sheet (the outputted query data) 
     Set pivot_sheet = work_book.Sheets.Add ' Create a new sheet for the pivot table 

     last_row = src_sheet.Range("A" & src_sheet.Rows.Count).End(-4162).row ' Get the index of the last row 
     last_column = src_sheet.Range("A1").End(-4161).Column ' Get the index of the last column 

     src_sheet.Name = "Source_Sheet" ' Change the name of the source sheet to..... "Source_Sheet"! 
     pivot_sheet.Name = "Pivot_Sheet" ' ...You get the idea 

     ' -------- Create the pivot table -------- ' 
     work_book.PivotCaches.Create(SourceType:=1, SourceData:="Source_Sheet!R1C1:R" & CStr(last_row) & "C" & CStr(last_column), Version:=1) _ 
      .CreatePivotTable TableDestination:="Pivot_Sheet!R1C1", _ 
      TableName:="PivotTable1", DefaultVersion:=1 

     src_sheet.Select 
     src_sheet.Cells(3, 1).Select 

     ' -------- Set the pivot table rows, column, and value: -------- ' 
     ' The last column of the query is the field for the Pivot Value & Column 

     Dim i As Integer 
     Dim field_name As String 
     For i = 1 To last_column 

      field_name = src_sheet.Cells(1, i).Value ' Get the field name 

      If i <> last_column Then 
       ' Set the row fields 
       With pivot_sheet.PivotTables("PivotTable1").PivotFields(field_name) 
        .Orientation = 1 ' 1 = xlRowField constant in early binding 
        .Position = i 
       End With 
      Else ' Last column 
       ' Create the value field 
       pivot_sheet.PivotTables("PivotTable1").AddDataField pivot_sheet.PivotTables(_ 
        "PivotTable1").PivotFields("Full_Name"), "Count of " & field_name, -4112 ' -4112 = xlCount constant 
       ' Create the column field 
       With pivot_sheet.PivotTables("PivotTable1").PivotFields(field_name) 
        .Orientation = 2 ' 2 = xlColumnField constant in early binding 
        .Position = 1 
       End With 
      End If 

      ' Turn off all subtotals: 
      pivot_sheet.PivotTables("PivotTable1").PivotFields(field_name).Subtotals _ 
      = Array(False, False, False, False, False, False, False, False, False, False, False, False) 

     Next i 

     ' -------- Change the pivot table properties --------' 

     ' Turn sheet from left to right 
     pivot_sheet.DisplayRightToLeft = False 
     ' Turn off row grand totals 
     pivot_sheet.PivotTables("PivotTable1").RowGrand = False 
     ' Turn on label repeat 
     pivot_sheet.PivotTables("PivotTable1").RepeatAllLabels 2 ' 2 = xlRepeatLabels in early binding 
     ' Show in Tabular Form 
     pivot_sheet.PivotTables("PivotTable1").RowAxisLayout 1 ' 1= xlTabularRow in early binding 
     ' Put 0 in empty cells 
     pivot_sheet.PivotTables("PivotTable1").NullString = "0" 

     pivot_sheet.Select 

     ' -------- Save & Close the workbook -------- ' 
     work_book.Save 
     work_book.Close 
     Set work_book = Nothing 
     Set excel_object = Nothing 
     Set src_sheet = Nothing 
     Set pivot_sheet = Nothing 

     MsgBox "Done Exporting!" 
    End If 
End Sub 

此代碼使用輸入查詢的最後一列爲值&數據透視表的列標題，其餘列爲行標題。

如您所見，代碼中的某些行設置了數據透視表的屬性。你可以改變這些行&添加新的。 你可以閱讀更多關於PivotTable object here。

用例：

Dim query_name As String 
Dim folder_name As String 
Dim file_name As String 

query_name = "rare_cats_query" 
file_name = "Rare_Cats_Pivot.xlsx" 
folder_name = "C:\Users\Drump\Desktop\" 

' Create the pivot table using the function "export_query_to_pivot" 
export_query_to_pivot query_name, folder_name, file_name 

我們查詢 「rare_cats_query」 導出到一個名爲 「Rare_Cats_Pivot.xlsx」 到用戶的桌面上的Excel文件。數據透視表是在新電子表格中創建的。