将我的 Access 表导出到 Excel，但将列中的不同值拆分到不同的工作表中

Posted 2023-04-19

【中文标题】将我的 Access 表导出到 Excel，但将列中的不同值拆分到不同的工作表中

【英文标题】：Export my Access table to Excel, but split different value in a column into different worksheets

【发布时间】：2020-06-17 07:33:28

【问题描述】：

我正在使用 Access VBA 为同事将表导出到 Excel，如果可以根据第 1 列中的值并将输出拆分为同一工作簿中的不同工作表并以第 1 列中的值命名，那将非常方便。

这是我目前用于将整个表格导出到 Excel 中的新工作簿的代码：

Private Sub export_Click()

    If IsNull(DLookup("Name", "MSysObjects", "Name='tbl_found_playingtimes'")) Then
        MsgBox ("No records to export.")
    Else

        Dim xlApp As Excel.Application
        Dim xlBook As Excel.Workbook
        Dim xlsheet As Excel.Worksheet

        Dim rs1 As DAO.Recordset

        DoCmd.Hourglass (True)

        Set rs1 = CurrentDb.OpenRecordset("tbl_found_playingtimes")

        Set xlApp = Excel.Application
        xlApp.Visible = False
        Set xlBook = xlApp.Workbooks.Add
        Set xlsheet = xlBook.Worksheets(1)

        With xlsheet

            .Name = "test"
            .Columns("I").NumberFormat = "0,00"
            .Range("A2").CopyFromRecordset rs1

            For cols = 0 To rs1.Fields.Count - 1
                .Cells(1, cols + 1).Value = rs1.Fields(cols).Name
            Next

        End With

    End If

SubExit:
On Error Resume Next
    DoCmd.Hourglass False
    xlApp.Visible = True
    Exit Sub

End Sub 

这很好用，除了一些障碍 - 一个数字列没有被导出 - 但我主要关心的是我是否可以将它拆分。每个标签编号将位于以标签编号命名的自己的工作表中。

【问题讨论】：

有几种方法可以解决 - 带回多少行数据？

您还需要New excel 应用程序。 Set xlApp = New Excel.Application.

@KostasK。 - 嗯，但我的代码可以正常输出到单张纸中。 “新”带来什么好处？

@jamheadart - 这是可变的。该数据库用于从大型数据库中搜索一些相关数据并导出到 Excel，因此它可以是从单行到数千行的任何数据。

搜索对象实例化。它有效并不一定意味着它是正确的。

【参考方案1】：

您需要做的是有一个“外部”记录集，其中包含唯一的标签编号列表，然后循环遍历它，将过滤后的数据输出到每个工作表。这样的事情应该让你开始：

Sub sExportExcel()
    Dim xlApp As New Excel.Application
    Dim xlBook As Excel.Workbook
    Dim xlSheet As Excel.Worksheet
    Dim db As DAO.Database
    Dim rsLabel As DAO.Recordset
    Dim rsData As DAO.Recordset
    Dim strSQL As String
    Dim lngLoop1 As Long
    Dim lngCount As Long
    Set db = DBEngine(0)(0)
    strSQL = "SELECT DISTINCT [label no] FROM tbl_found_playing_times ORDER BY [label no] ASC;"
    Set rsLabel = db.OpenRecordset(strSQL)
    If Not (rsLabel.BOF And rsLabel.EOF) Then
        Set xlBook = xlApp.Workbooks.Add
        Do
            Set xlSheet = xlBook.Worksheets.Add(After:=xlBook.Worksheets(xlBook.Worksheets.Count))
            xlSheet.name = rsLabel("label no")
            strSQL = "SELECT * FROM tbl_found_playing_times WHERE [label no]=" & rsLabel("label no")
            Set rsData = db.OpenRecordset(strSQL)
            If Not (rsData.BOF And rsData.EOF) Then
                xlSheet.Range("A2").CopyFromRecordset rsData
            End If
            rsLabel.MoveNext
        Loop Until rsLabel.EOF
        lngCount = xlBook.Worksheets.Count
        For lngLoop1 = lngCount To 1 Step -1
            If Left(xlBook.Worksheets(lngLoop1).name, 5) = "Sheet" Then
                xlBook.Worksheets(lngLoop1).Delete
            End If
        Next lngLoop1
        xlBook.Worksheets(1).Select
        xlApp.Visible = True
    End If  
End Sub

问候，

【讨论】：

通过一些调整（第二条 SQL 语句需要一些额外的撇号）就可以很好地工作，非常感谢。这是一个很大的帮助！