From 67b9f8c0f8b7039cd518f0feba55c2ef441f2608 Mon Sep 17 00:00:00 2001
From: Kenichiro NOGI <systemadmin@next-hd.co.jp>
Date: Fri, 18 Sep 2026 18:44:42 +0900
Subject: [PATCH] =?UTF-8?q?fix:=20Export/Get=E6=96=B9=E5=BC=8F=E3=81=A8?=
 =?UTF-8?q?=E3=82=820=E4=BB=B6=E5=8F=96=E5=BE=97=E6=99=82=E3=81=AB?=
 =?UTF-8?q?=E3=83=86=E3=83=BC=E3=83=96=E3=83=AB=E3=81=AE=E3=83=87=E3=83=BC?=
 =?UTF-8?q?=E3=82=BF=E9=83=A8=E5=88=86=E3=82=92=E3=82=AF=E3=83=AA=E3=82=A2?=
 =?UTF-8?q?=E3=81=99=E3=82=8B=E3=82=88=E3=81=86=E4=BF=AE=E6=AD=A3?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

従来は0件時にMsgBoxを出して即終了し、テーブルの前回データがそのまま残ってしまっていた。
runGetFlowはrecords.count=0でもgetRecordsDataToSheetを呼ぶよう変更し、getRecordsDataToSheet/exportCSVDataToSheetは0件時にMsgBoxを出さずヘッダを維持したままDataBodyRangeだけクリアするよう修正。

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

diff --git a/XVBA/新版着工要因閲覧シート/vba-files/Module/Module1.bas b/XVBA/新版着工要因閲覧シート/vba-files/Module/Module1.bas
index 95384911..4f0f3331 100644
--- a/XVBA/新版着工要因閲覧シート/vba-files/Module/Module1.bas
+++ b/XVBA/新版着工要因閲覧シート/vba-files/Module/Module1.bas
@@ -106,9 +106,6 @@ Function runGetFlow() As Boolean
     If records Is Nothing Then
         Debug.Print "�f�[�^���擾�ł��܂���ł���"
         runGetFlow = False
-    ElseIf records.count = 0 Then
-        Debug.Print "�f�[�^���擾�ł��܂���ł���"
-        runGetFlow = False
     Else
         Call getRecordsDataToSheet(records, tableId & "G")
         t2 = Timer
@@ -180,8 +177,17 @@ Function exportCSVDataToSheet(csvData As Variant, targetSheet As String)
         Set rows = ParseCsv(csvData)
 
         If rows.count <= 1 Then
-            MsgBox "�f�[�^�����݂��܂���i�w�b�_�̂݁j: " & targetSheet, vbExclamation
-         Exit Function
+            Debug.Print "�f�[�^��0���̂��߁A�����e�[�u���̃f�[�^�������N���A���܂�: " & targetSheet
+            Dim tblEmpty As ListObject
+            On Error Resume Next
+            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
+                End If
+            End If
+            Exit Function
         End If
 
         maxCols = 0
@@ -448,11 +454,6 @@ End Function
 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)
@@ -464,6 +465,20 @@ Function getRecordsDataToSheet(records As Collection, targetSheet As String)
         ws.Name = targetSheet
     End If
 
+    If records.count = 0 Then
+        Debug.Print "�f�[�^��0���̂��߁A�����e�[�u���̃f�[�^�������N���A���܂�: " & targetSheet
+        Dim tblEmpty As ListObject
+        On Error Resume Next
+        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
+            End If
+        End If
+        Exit Function
+    End If
+
     Dim flatRecords As New Collection
     Dim rec As Dictionary
     For Each rec In records