From a60244b7b039fb218f3bad8b17f527cc8dc12cd1 Mon Sep 17 00:00:00 2001
From: Kenichiro NOGI <systemadmin@next-hd.co.jp>
Date: Fri, 18 Sep 2026 18:56:37 +0900
Subject: [PATCH] =?UTF-8?q?fix:=20=E3=83=86=E3=83=BC=E3=83=96=E3=83=ABResi?=
 =?UTF-8?q?ze=E6=99=82=E3=81=ABDataBodyRange=E3=81=8CNothing=E3=81=AE?=
 =?UTF-8?q?=E3=81=BE=E3=81=BE=E3=81=AB=E3=81=AA=E3=82=8B=E5=95=8F=E9=A1=8C?=
 =?UTF-8?q?=E3=82=92=E4=BF=AE=E6=AD=A3?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

Excelのテーブル(ListObject)は、直前と同一サイズへのResizeを行うとDataBodyRangeの内部状態が更新されないことがあり、
データ行数が変わらない場合(前回0件クリア後に1件だけ取得した場合など)にDataBodyRange.Value代入が効かず、
テーブルにデータが書き込まれない不具合があった。
exportCSVDataToSheet/getRecordsDataToSheet/exportCSVDataToExistingTableの3箇所で、
一旦ヘッダ行のみにリサイズしてから目的のサイズにリサイズし直すことで回避。
調査用の詳細デバッグログ([DEBUG] records.count等)も合わせて追加。

Co-Authored-By: Claude Sonnet 5 <noreply@anthropic.com>
---
 .../vba-files/Module/Module1.bas              | 28 +++++++++++++++++++
 1 file changed, 28 insertions(+)

diff --git a/XVBA/新版着工要因閲覧シート/vba-files/Module/Module1.bas b/XVBA/新版着工要因閲覧シート/vba-files/Module/Module1.bas
index 4f0f3331..a4a0de5d 100644
--- a/XVBA/新版着工要因閲覧シート/vba-files/Module/Module1.bas
+++ b/XVBA/新版着工要因閲覧シート/vba-files/Module/Module1.bas
@@ -235,6 +235,9 @@ Function exportCSVDataToSheet(csvData As Variant, targetSheet As String)
             End If
 
             ' �e�[�u���Ƀf�[�^��lj��i�w�b�_�s(arr(0,*))���������f�[�^�����݂̂�DataBodyRange�ɏ������ށj
+            '���O�Ɠ���T�C�Y�ւ�Resize����Excel��DataBodyRange�̓�����Ԃ��X�V���Ȃ����Ƃ����邽�߁A
+            '��U�w�b�_�s�݂̂Ƀ��T�C�Y���Ă���ړI�̃T�C�Y�Ƀ��T�C�Y������
+            tbl.Resize tbl.Range.Resize(1, maxCols)
             tbl.Resize tbl.Range.Resize(rows.count, maxCols)
 
             Dim dataArr() As Variant
@@ -479,12 +482,16 @@ Function getRecordsDataToSheet(records As Collection, targetSheet As String)
         Exit Function
     End If
 
+    Debug.Print "  [DEBUG] records.count = " & records.count
+
     Dim flatRecords As New Collection
     Dim rec As Dictionary
     For Each rec In records
         flatRecords.Add FlattenRecord(rec)
     Next rec
 
+    Debug.Print "  [DEBUG] flatRecords.count = " & flatRecords.count
+
     Dim headerDict As Dictionary
     Set headerDict = flatRecords(1)
     Dim headerKeys As Variant
@@ -492,6 +499,8 @@ Function getRecordsDataToSheet(records As Collection, targetSheet As String)
     Dim maxCols As Long
     maxCols = headerDict.count
 
+    Debug.Print "  [DEBUG] maxCols = " & maxCols
+
     Dim i As Long, j As Long
     Dim dataArr() As Variant
     ReDim dataArr(1 To flatRecords.count, 1 To maxCols)
@@ -503,11 +512,16 @@ Function getRecordsDataToSheet(records As Collection, targetSheet As String)
         Next j
     Next i
 
+    Debug.Print "  [DEBUG] dataArr dims = " & UBound(dataArr, 1) & " x " & UBound(dataArr, 2)
+    Debug.Print "  [DEBUG] dataArr(1,1) = " & CStr(dataArr(1, 1)) & " / dataArr(1,2) = " & CStr(dataArr(1, 2))
+
     Dim tbl As ListObject
     On Error Resume Next
     Set tbl = ws.ListObjects(targetSheet)
     On Error GoTo 0
 
+    Debug.Print "  [DEBUG] tbl Is Nothing (before) = " & (tbl Is Nothing)
+
     Dim headerRange As Range
     Set headerRange = ws.Range("A1").Resize(1, maxCols)
     For j = 0 To maxCols - 1
@@ -520,12 +534,23 @@ Function getRecordsDataToSheet(records As Collection, targetSheet As String)
         tbl.Name = targetSheet
     End If
 
+    Debug.Print "  [DEBUG] tbl.Range.Address (before resize) = " & tbl.Range.Address
+
     If Not tbl.DataBodyRange Is Nothing Then
         tbl.DataBodyRange.ClearContents
     End If
 
+    '�e�[�u���͈͂����O�Ɠ���T�C�Y����Excel��DataBodyRange�̓�����Ԃ��X�V���Ȃ����Ƃ����邽�߁A
+    '��U�w�b�_�s�݂̂Ƀ��T�C�Y���Ă���ړI�̃T�C�Y�Ƀ��T�C�Y������
+    tbl.Resize tbl.Range.Resize(1, maxCols)
     tbl.Resize tbl.Range.Resize(flatRecords.count + 1, maxCols)
+    Debug.Print "  [DEBUG] tbl.Range.Address (after resize) = " & tbl.Range.Address
+    Debug.Print "  [DEBUG] tbl.DataBodyRange Is Nothing (after resize) = " & (tbl.DataBodyRange Is Nothing)
+    If Not tbl.DataBodyRange Is Nothing Then
+        Debug.Print "  [DEBUG] tbl.DataBodyRange.Address = " & tbl.DataBodyRange.Address & " / Rows.count=" & tbl.DataBodyRange.Rows.count & " / Columns.count=" & tbl.DataBodyRange.Columns.count
+    End If
     tbl.DataBodyRange.Value = dataArr
+    Debug.Print "  [DEBUG] after assign, A2 cell value = [" & ws.Range("A2").Value & "]"
 
     Debug.Print "���R�[�h�̃V�[�g�o�͊���: " & targetSheet
 End Function
@@ -680,6 +705,9 @@ Function exportCSVDataToExistingTable(csvData As Variant, tableName As String)
         tbl.DataBodyRange.ClearContents
     End If
 
+    '���O�Ɠ���T�C�Y�ւ�Resize����Excel��DataBodyRange�̓�����Ԃ��X�V���Ȃ����Ƃ����邽�߁A
+    '��U�w�b�_�s�݂̂Ƀ��T�C�Y���Ă���ړI�̃T�C�Y�Ƀ��T�C�Y������
+    tbl.Resize tbl.Range.Resize(1, maxCols)
     tbl.Resize tbl.Range.Resize(rows.count, maxCols)
 
     Dim dataArr() As Variant