From 96133b892989b8acb185778b596e4d12345636aa Mon Sep 17 00:00:00 2001
From: Kenichiro NOGI <systemadmin@next-hd.co.jp>
Date: Fri, 11 Sep 2026 13:30:34 +0900
Subject: [PATCH] =?UTF-8?q?feat:=20Get=E6=96=B9=E5=BC=8F=E3=81=AE=E3=83=AC?=
 =?UTF-8?q?=E3=82=B3=E3=83=BC=E3=83=89=E3=82=92=E3=83=86=E3=83=BC=E3=83=96?=
 =?UTF-8?q?=E3=83=AB=E3=81=AB=E6=9B=B8=E3=81=8D=E8=BE=BC=E3=82=80getRecord?=
 =?UTF-8?q?sDataToSheet=E3=82=92=E8=BF=BD=E5=8A=A0?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 .../vba-files/Module/Module1.bas              | 73 +++++++++++++++++++
 1 file changed, 73 insertions(+)

diff --git a/XVBA/新版着工要因閲覧シート/vba-files/Module/Module1.bas b/XVBA/新版着工要因閲覧シート/vba-files/Module/Module1.bas
index db77d563..81d27514 100644
--- a/XVBA/新版着工要因閲覧シート/vba-files/Module/Module1.bas
+++ b/XVBA/新版着工要因閲覧シート/vba-files/Module/Module1.bas
@@ -342,6 +342,79 @@ Function FlattenRecord(record As Dictionary) As Dictionary
     Set FlattenRecord = flat
 End Function
 
+'******************************************************************************
+'Get�����Ŏ擾�������R�[�h���V�[�g�ɏ������ށiexportCSVDataToSheet�Ƃ͓Ɨ������j
+'�w�b�_�̓t���b�g�����1���ڃ��R�[�h�̃L�[�ꗗ�����̂܂܎g�p����i�����L�[���̂܂܁A���{�ꃉ�x���ϊ��͂��Ȃ��j
+Function getRecordsDataToSheet(records As Collection, targetSheet As String)
+    Debug.Print "���R�[�h���V�[�g�ɏo�͊J�n: " & targetSheet
+
+    If records.count = 0 Then
+        MsgBox "�f�[�^�����݂��܂���: " & 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 "�V�[�g�����݂��Ȃ����ߐV�K�쐬: " & 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 "�e�[�u�������݂��Ȃ����ߐV�K�쐬: " & 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 "���R�[�h�̃V�[�g�o�͊���: " & targetSheet
+End Function
+
 '******************************************************************************
 'REST API�ďo����
 '�@method�@Get��POST��