使用 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 文件到用户桌面。在新电子表格中创建数据透视表。