excel - 将我的 Access 表导出到 Excel,但将列中的不同值拆分到不同的工作表中
问题描述
我正在使用 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
这工作得很好,除了一些障碍 - 一个数字列没有被导出 - 但我主要关心的是我是否可以把它分开。每个标签编号将位于以标签编号命名的自己的工作表中。
解决方案
您需要做的是拥有一个包含唯一标签编号列表的“外部”记录集,然后循环遍历它,将过滤后的数据输出到每个工作表。这样的事情应该让你开始:
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
问候,
推荐阅读
- r - R data.table/frame中按组在不同列中的前行值与当前行值的总和比率
- pdf - .Core PDF 创建
- sql - 从连续日期中查找最近的开始日期和结束日期
- mysql - Power BI:通过记录行索引将 JSON 记录转换为列
- blockchain - 如何将用户在substrate中传递的函数调用参数放入txn-pallet?
- python - 无法在 Kaggle 笔记本上的 python 中使用辅助函数
- javascript - 关注 Reactjs 上的推文后 Twitter 绑定
- javascript - 对多个请求使用 SWR
- gams-math - 从 GAMS 中删除特定方程
- python - 为什么 Table 上没有滚动条?