From 05443652767c23661667ed9e7eb062391c434941 Mon Sep 17 00:00:00 2001
From: Kenichiro NOGI <systemadmin@next-hd.co.jp>
Date: Fri, 18 Sep 2026 19:07:02 +0900
Subject: [PATCH] =?UTF-8?q?fix:=20=E3=83=86=E3=83=BC=E3=83=96=E3=83=AB?=
 =?UTF-8?q?=E6=9B=B8=E8=BE=BC=E3=81=BF=E3=82=92DataBodyRange=E3=83=97?=
 =?UTF-8?q?=E3=83=AD=E3=83=91=E3=83=86=E3=82=A3=E3=81=AB=E4=BE=9D=E5=AD=98?=
 =?UTF-8?q?=E3=81=97=E3=81=AA=E3=81=84=E5=AE=9F=E8=A3=85=E3=81=AB=E5=85=A8?=
 =?UTF-8?q?=E9=9D=A2=E5=A4=89=E6=9B=B4?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

DataBodyRangeは、直前と同一サイズへのResizeだけでなくヘッダ+1データ行という特定サイズへのResizeでも
内部状態が更新されずNothingのままになるケースがあり、tempRows経由の2段階Resizeでも解消しなかった。
根本対応として、exportCSVDataToSheet/getRecordsDataToSheet/exportCSVDataToExistingTableの3関数で
DataBodyRangeを一切使わず、tbl.Range(ヘッダ含む全体範囲)から直接Offset/Resizeで計算したRangeに
クリア・書き込みを行う方式に統一。調査用デバッグログも整理した。

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

diff --git a/XVBA/新版着工要因閲覧シート/vba-files/Module/Module1.bas b/XVBA/新版着工要因閲覧シート/vba-files/Module/Module1.bas
index 74d49a6d..4514ca77 100644
--- a/XVBA/新版着工要因閲覧シート/vba-files/Module/Module1.bas
+++ b/XVBA/新版着工要因閲覧シート/vba-files/Module/Module1.bas
@@ -190,8 +190,8 @@ Function exportCSVDataToSheet(csvData As Variant, targetSheet As String)
             Set tblEmpty = ws.ListObjects(targetSheet)
             On Error GoTo 0
             If Not tblEmpty Is Nothing Then
-                If Not tblEmpty.DataBodyRange Is Nothing Then
-                    tblEmpty.DataBodyRange.ClearContents
+                If tblEmpty.Range.Rows.count > 1 Then
+                    tblEmpty.Range.Resize(tblEmpty.Range.Rows.count - 1, tblEmpty.Range.Columns.count).Offset(1, 0).ClearContents
                 End If
             End If
             Exit Function
@@ -236,17 +236,13 @@ Function exportCSVDataToSheet(csvData As Variant, targetSheet As String)
                 tbl.Name = targetSheet
             End If
 
-            '�e�[�u���̃f�[�^�������N���A
-            If Not tbl.DataBodyRange Is Nothing Then
-                tbl.DataBodyRange.ClearContents
+            '�����f�[�^�����𖈉�N���A�iDataBodyRange�v���p�e�B�͓�����Ԃ��X�V���ꂸ
+            'Nothing�̂܂܂ɂȂ邱�Ƃ����邽�ߎg�킸�A�e�[�u���͈͂��璼�ڌv�Z����j
+            If tbl.Range.Rows.count > 1 Then
+                tbl.Range.Resize(tbl.Range.Rows.count - 1, tbl.Range.Columns.count).Offset(1, 0).ClearContents
             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������
-            Dim tempRows As Long
-            tempRows = tbl.Range.Rows.count + rows.count + 1
-            tbl.Resize tbl.Range.Resize(tempRows, maxCols)
+            ' �e�[�u����ړI�̃T�C�Y�Ƀ��T�C�Y
             tbl.Resize tbl.Range.Resize(rows.count, maxCols)
 
             Dim dataArr() As Variant
@@ -256,7 +252,11 @@ Function exportCSVDataToSheet(csvData As Variant, targetSheet As String)
                     dataArr(i, j) = arr(i, j - 1)
                 Next j
             Next i
-            tbl.DataBodyRange.Value = dataArr
+
+            '�f�[�^�������݁iDataBodyRange�v���p�e�B���g�킸�A�w�b�_�s�̎�����e�[�u���͈͂𒼐ڌv�Z����j
+            Dim dataRange As Range
+            Set dataRange = tbl.Range.Resize(rows.count - 1, maxCols).Offset(1, 0)
+            dataRange.Value = dataArr
 
             '------------------------------------------
             Debug.Print "CSV�f�[�^���V�[�g�ɏo�͊���: " & targetSheet
@@ -484,23 +484,19 @@ Function getRecordsDataToSheet(records As Collection, targetSheet As String)
         Set tblEmpty = ws.ListObjects(targetSheet)
         On Error GoTo 0
         If Not tblEmpty Is Nothing Then
-            If Not tblEmpty.DataBodyRange Is Nothing Then
-                tblEmpty.DataBodyRange.ClearContents
+            If tblEmpty.Range.Rows.count > 1 Then
+                tblEmpty.Range.Resize(tblEmpty.Range.Rows.count - 1, tblEmpty.Range.Columns.count).Offset(1, 0).ClearContents
             End If
         End If
         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
@@ -508,8 +504,6 @@ 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)
@@ -521,16 +515,11 @@ 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
@@ -543,25 +532,19 @@ 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
+    '�����f�[�^�����𖈉�N���A�iDataBodyRange�v���p�e�B�͓�����Ԃ��X�V���ꂸ
+    'Nothing�̂܂܂ɂȂ邱�Ƃ����邽�ߎg�킸�A�e�[�u���͈͂��璼�ڌv�Z����j
+    If tbl.Range.Rows.count > 1 Then
+        tbl.Range.Resize(tbl.Range.Rows.count - 1, tbl.Range.Columns.count).Offset(1, 0).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������
-    Dim tempRows As Long
-    tempRows = tbl.Range.Rows.count + flatRecords.count + 2
-    tbl.Resize tbl.Range.Resize(tempRows, maxCols)
+    ' �e�[�u����ړI�̃T�C�Y�Ƀ��T�C�Y
     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 & "]"
+
+    '�f�[�^�������݁iDataBodyRange�v���p�e�B���g�킸�A�w�b�_�s�̎�����e�[�u���͈͂𒼐ڌv�Z����j
+    Dim dataRange As Range
+    Set dataRange = tbl.Range.Resize(flatRecords.count, maxCols).Offset(1, 0)
+    dataRange.Value = dataArr
 
     Debug.Print "���R�[�h�̃V�[�g�o�͊���: " & targetSheet
 End Function
@@ -690,7 +673,10 @@ Function exportCSVDataToExistingTable(csvData As Variant, tableName As String)
     Set rows = ParseCsv(csvData)
 
     If rows.count <= 1 Then
-        MsgBox "�f�[�^�����݂��܂���i�w�b�_�̂݁j: " & tableName, vbExclamation
+        Debug.Print "�f�[�^��0���̂��߁A�����e�[�u���̃f�[�^�������N���A���܂�: " & tableName
+        If tbl.Range.Rows.count > 1 Then
+            tbl.Range.Resize(tbl.Range.Rows.count - 1, tbl.Range.Columns.count).Offset(1, 0).ClearContents
+        End If
         Exit Function
     End If
 
@@ -712,15 +698,13 @@ Function exportCSVDataToExistingTable(csvData As Variant, tableName As String)
         i = i + 1
     Next rowArr
 
-    If Not tbl.DataBodyRange Is Nothing Then
-        tbl.DataBodyRange.ClearContents
+    '�����f�[�^�����𖈉�N���A�iDataBodyRange�v���p�e�B�͓�����Ԃ��X�V���ꂸ
+    'Nothing�̂܂܂ɂȂ邱�Ƃ����邽�ߎg�킸�A�e�[�u���͈͂��璼�ڌv�Z����j
+    If tbl.Range.Rows.count > 1 Then
+        tbl.Range.Resize(tbl.Range.Rows.count - 1, tbl.Range.Columns.count).Offset(1, 0).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������
-    Dim tempRows As Long
-    tempRows = tbl.Range.Rows.count + rows.count + 1
-    tbl.Resize tbl.Range.Resize(tempRows, maxCols)
+    ' �e�[�u����ړI�̃T�C�Y�Ƀ��T�C�Y
     tbl.Resize tbl.Range.Resize(rows.count, maxCols)
 
     Dim dataArr() As Variant
@@ -730,7 +714,11 @@ Function exportCSVDataToExistingTable(csvData As Variant, tableName As String)
             dataArr(i, j) = arr(i, j - 1)
         Next j
     Next i
-    tbl.DataBodyRange.Value = dataArr
+
+    '�f�[�^�������݁iDataBodyRange�v���p�e�B���g�킸�A�w�b�_�s�̎�����e�[�u���͈͂𒼐ڌv�Z����j
+    Dim dataRange As Range
+    Set dataRange = tbl.Range.Resize(rows.count - 1, maxCols).Offset(1, 0)
+    dataRange.Value = dataArr
 
     Debug.Print "CSV�f�[�^�������e�[�u���ɏo�͊���: " & tableName
 End Function