feat: Get方式のレコードをテーブルに書き込むgetRecordsDataToSheetを追加

XVBA/新版着工要因閲覧シート/vba-files/Module/Module1.bas

@@ -342,6 +342,79 @@ Function FlattenRecord(record As Dictionary) As Dictionary
     Set FlattenRecord = flat
 End Function
 
+'******************************************************************************
+'Get方式で取得したレコードをシートに書き込む（exportCSVDataToSheetとは独立実装）
+'ヘッダはフラット化後の1件目レコードのキー一覧をそのまま使用する（内部キー名のまま、日本語ラベル変換はしない）
+Function getRecordsDataToSheet(records As Collection, targetSheet As String)
+    Debug.Print "レコードをシートに出力開始: " & targetSheet
+
+    If records.count = 0 Then
+        MsgBox "データが存在しません: " & targetSheet, vbExclamation
+        Exit Function
+    End If
+
+    Dim ws As Worksheet
+    On Error Resume Next
+    Set ws = ThisWorkbook.Sheets(targetSheet)
+    On Error GoTo 0
+
+    If ws Is Nothing Then
+        Debug.Print "シートが存在しないため新規作成: " & targetSheet
+        Set ws = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.count))
+        ws.Name = targetSheet
+    End If
+
+    Dim flatRecords As New Collection
+    Dim rec As Variant
+    For Each rec In records
+        flatRecords.Add FlattenRecord(rec)
+    Next rec
+
+    Dim headerDict As Dictionary
+    Set headerDict = flatRecords(1)
+    Dim headerKeys As Variant
+    headerKeys = headerDict.Keys
+    Dim maxCols As Long
+    maxCols = headerDict.count
+
+    Dim i As Long, j As Long
+    Dim dataArr() As Variant
+    ReDim dataArr(1 To flatRecords.count, 1 To maxCols)
+    For i = 1 To flatRecords.count
+        Dim curRec As Dictionary
+        Set curRec = flatRecords(i)
+        For j = 1 To maxCols
+            dataArr(i, j) = curRec(headerKeys(j - 1))
+        Next j
+    Next i
+
+    Dim tbl As ListObject
+    On Error Resume Next
+    Set tbl = ws.ListObjects(targetSheet)
+    On Error GoTo 0
+
+    Dim headerRange As Range
+    Set headerRange = ws.Range("A1").Resize(1, maxCols)
+    For j = 0 To maxCols - 1
+        headerRange.Cells(1, j + 1).Value = headerKeys(j)
+    Next j
+
+    If tbl Is Nothing Then
+        Debug.Print "テーブルが存在しないため新規作成: " & targetSheet
+        Set tbl = ws.ListObjects.Add(xlSrcRange, headerRange, , xlYes)
+        tbl.Name = targetSheet
+    End If
+
+    If Not tbl.DataBodyRange Is Nothing Then
+        tbl.DataBodyRange.ClearContents
+    End If
+
+    tbl.Resize tbl.Range.Resize(flatRecords.count + 1, maxCols)
+    tbl.DataBodyRange.Value = dataArr
+
+    Debug.Print "レコードのシート出力完了: " & targetSheet
+End Function
+
 '******************************************************************************
 'REST API呼出処理
 '　method　GetかPOSTか