Question

我的数据库包含超过4,000,000个术中温度读数（4354499 x 8）。因此，数据库太大而无法复制和粘贴。

变量：

caseID - 外科病例的唯一标识符。如果一名患者在不同的日子进行多次手术，每次手术都会有不同的病例ID

温度 - 温度值

时间 - 记录温度的时间

在整个手术过程中每15秒钟进行一次温度读数，因此具有500多个温度读数的病例是常态。每个外科病例都有自己的唯一标识符（caseID），但caseID对于所有500个读数都是相同的。

我需要的是一种自动提取每种情况的温度读数的方法。它可以采用以下任何格式：

1个包含多个工作表的Excel工作簿，每个工作表包含与一个caseID相关的所有温度读数。如果Excel限制工作簿中的工作表数量，则此操作可能无效。
许多Excel工作簿，每个工作簿都包含一个caseID的温度读数（可能是首选，因为我不介意拥有大量文件）

Answer 1

在最基本的形式中，您正在寻找的是一些像这样的VBA代码：

Public Function DumpTempsByCaseToExcel() As Boolean
Dim cdb As DAO.Database, rst As DAO.Recordset, qdf As DAO.QueryDef

Const OutPath = "C:\Users\Gord\Desktop\"
Const DataTableName = "Temperatures"
Const TempQueryDefName = "zzzTempQuery"

Set cdb = CurrentDb
Set rst = cdb.OpenRecordset("SELECT DISTINCT caseID FROM [" & DataTableName & "]", dbOpenSnapshot)
Do While Not rst.EOF
    On Error Resume Next
    cdb.QueryDefs.Delete TempQueryDefName
    On Error GoTo DumpTempsByCaseToExcel_Error
    Set qdf = cdb.CreateQueryDef(TempQueryDefName, "SELECT * FROM [" & DataTableName & "] WHERE caseID=""" & rst!caseID & """")
    Set qdf = Nothing
    DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, TempQueryDefName, OutPath & rst!caseID & ".xlsx"
    rst.MoveNext
Loop
rst.Close
Set rst = Nothing
Set cdb = Nothing
DumpTempsByCaseToExcel = True
Exit Function

DumpTempsByCaseToExcel_Error:
MsgBox Err.Description, vbCritical, "Runtime error " & Err.Number
DumpTempsByCaseToExcel = False
End Function

假设：

您的[caseID]值是字母数字。如果它们是数字，那么你将不得不在构建WHERE子句的代码中使用引号。
您的[caseID]值可用作有效的Windows文件名。如果它们包含在Windows fimenames中无效的字符，那么您必须使用类似Replace()函数的内容删除它们或将它们映射到其他内容。
您的目标文件夹为空，或者至少不包含与您要创建的文件同名的文件。写为的示例代码可能覆盖现有文件。

通过该标识符将给定标识符的每个条目导出到excel工作簿

1 个答案: