【发布时间】：2019-01-07 05:34:35
【问题描述】：
我正在尝试研究如何将查询的唯一记录拆分到同一个 Excel 工作簿（模板文件）中的新工作表中。我的访问查询有以下字段：
项目编号、项目名称、任务编号、项目发起人、全年预算、4 月、5 月、6 月、7 月、8 月、9 月、10 月、11 月、12 月、1 月、2 月、3 月、全年、年度预测。
我希望能够为每个项目编号创建一个新的工作表并列出相关数据，并将工作表重命名为项目编号...在花了几个小时玩弄其他代码后，我有一个完整的思维障碍类似的请求，但无法按照我需要的方式行事？
有没有人有想法或可以为我指出正确的方向，我在 vba 不是一个完全的新手，但这个让我很好，真的被卡住了。
非常感谢:)
大家好，感谢您的建议，我已经设法将代码拼凑在一起以溢出数据并导出到各个工作表并且工作正常。我现在需要将任何关联数据从另一个查询复制到相关工作表在其他数据下方的“表格”中，但我运气不佳。它要么将一条记录复制到其中一个工作表，要么将所有记录复制到单个工作表，而不管。谁能指出我正确的方向？
Option Compare Database
Global iter As Integer
Sub Loop_Practice2()
Dim rs As DAO.Recordset
Dim ProjectNumber As DAO.Recordset
Dim i As Integer
Dim j As Integer
Dim Worksheet_Count As Integer
Dim sSql As String
Dim Project_Count As Integer
Dim iCol As Integer
Dim mypath As String
Dim mvalue As String
Dim myfile As String
Dim mynewfile As String
Dim mynewpath As String
Dim wb As Excel.Workbook
Dim WS As Excel.Worksheet
Dim sFile As String
mypath = Application.CurrentProject.Path & "\"
myfile = ("PIN Export Template.xlsx")
mynewpath = (Application.CurrentProject.Path & "\")
mynewfile = ("PIN Export Template.xlsx - " & Format(Now(), "yyyy-mm-dd") & ".xlsx")
sFile = mypath & myfile
' ' Use Dir to check if file exists
If Dir(sFile) = "" Then
' if file does not exist display message
MsgBox "Could not find the file " & sFile & " - Please ensure it is in the same location as the database."
Exit Sub
End If
'Open Excel
Excel.Application.Visible = True
Excel.Application.Workbooks.Open (sFile)
'Define Access Query to be exported
Set ProjectNumber = CurrentDb.OpenRecordset("SELECT DISTINCT qry_MP_PDP_PIN_Analysis_Step_01_FY_Position_Monthly.[Project Number] from qry_MP_PDP_PIN_Analysis_Step_01_FY_Position_Monthly")
If ProjectNumber.EOF Then Exit Sub
ProjectNumber.MoveLast
Project_Count = ProjectNumber.RecordCount - 1
ProjectNumber.MoveFirst
'Create individual PIN sheets from Query Dataset
Excel.Application.Worksheets("PIN").Select
Worksheet_Count = Excel.Application.Worksheets("PIN").Select
Do Until Worksheet_Count = Project_Count
Worksheets("PIN").Copy After:=Worksheets("PIN")
If iter = 0 Then
iter = 1
End If
ActiveSheet.Name = ("PIN") & iter
iter = iter + 1
Worksheet_Count = Worksheet_Count + 1
Loop
j = 1
'Add qry_MP_PDP_PIN_Analysis_Step_01_FY_Position_Monthly data
Do Until ProjectNumber.EOF
sSql = "SELECT *"
sSql = sSql & " FROM qry_MP_PDP_PIN_Analysis_Step_01_FY_Position_Monthly"
sSql = sSql & " Where qry_MP_PDP_PIN_Analysis_Step_01_FY_Position_Monthly.[Project Number]=" & ProjectNumber("[Project Number]")
Set rs = CurrentDb.OpenRecordset(sSql, dbOpenDynaset)
Set Pin_Sheet = ActiveWorkbook.Sheets("PIN" & j)
'Rename the PIN sheet to individual Project Number
Pin_Sheet.Name = ProjectNumber("[Project Number]")
'Create PIN Analysis Column Headings
For iCol = 0 To rs.Fields.Count - 1
Pin_Sheet.Cells(13, iCol + 4).Value = rs.Fields(iCol).Name
Next
'Populate PIN_Analysis_Step_01_FY_Position_Monthly Data
Pin_Sheet.Cells(14, 4).CopyFromRecordset rs
j = j + 1
ProjectNumber.MoveNext
Loop
Excel.Application.ActiveWorkbook.SaveAs (mynewpath & mynewfile)
Set Pin_Sheet = Nothing
Set ProjectNumber = Nothing
Set ProjectNumber2 = Nothing
Set rs = Nothing
Set ProjectNumber = Nothing
Set wb = Nothing
Set WS = Nothing
CurrentDb.Close
ActiveWorkbook.Close
Excel.Application.Quit
End Sub
【问题讨论】：
-
欢迎来到 Stack Overflow。目前，这个问题太宽泛了。仅选择唯一值、导出数据和重命名工作表都是非常不同的任务。请仅询问其中一项，并提供足够的信息来回答（例如样本数据，您最有希望的尝试）。
-
嗨@ErikvonAsmuth，感谢您的更新，我明白您在这里所说的内容，只是不确定如何解释我正在尝试做的事情......基本上我有一个查询 - qry_MP_PDP_PIN_Analysis_Step_01_FY_Position_Monthly。这里面有几百条记录，但这些是 5 个项目编号的详细信息。虽然我知道如何将整个数据集传输到现有工作表，但我无法锻炼如何按项目编号拆分这些数据并将每个项目编号导出到工作表？我不知道该怎么做...
-
@CBHodgetts 。首先创建一个查询，其中您有不同的项目编号，而不是遍历您的记录集以获得不同的项目编号，并将此项目编号用作您的 Excel 工作表名称。