-1

4,000,000 を超える手術中の温度測定値 (4354499 x 8) を含むデータベースがあります。したがって、データベースが大きすぎてコピー アンド ペーストできません。

変数:

caseID - 手術ケースの一意の識別子。1 人の患者が異なる日に複数の手術を受ける場合、手術ごとに異なる caseID が存在します。

温度- 温度値

time - 温度が記録された時間

温度測定値は手術中 15 秒ごとに取得されるため、500 を超える温度測定値を持つケースが標準です。各手術ケースには独自の一意の識別子 (caseID) がありますが、caseID は 500 の読み取りすべてで同じになります。

私が必要としているのは、各ケースの温度測定値を抽出するための自動化された方法です。次のいずれかの形式になります。

  • 複数のワークシートを含む 1 つの Excel ワークブック。各ワークシートには、1 つのケース ID に関連するすべての温度測定値が含まれます。Excel がブック内のワークシートの数を制限している場合、これは機能しない可能性があります。
  • それぞれが 1 つのケース ID の温度測定値を含む多数の Excel ワークブック (大量のファイルを使用してもかまわないため、おそらく推奨されます)
4

1 に答える 1

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 のファイル名で無効な文字が含まれている場合は、Replace()関数のようなものを使用してそれらを削除するか、別のものにマップする必要があります。

  • 宛先フォルダーが空であるか、少なくとも作成するファイルと同じ名前のファイルが含まれていません。記述されているサンプル コードは、既存のファイルを上書きする可能性があります。

于 2013-03-29T14:18:02.423 に答える