fix: テーブルResize時にDataBodyRangeがNothingのままになる問題を修正
Excelのテーブル(ListObject)は、直前と同一サイズへのResizeを行うとDataBodyRangeの内部状態が更新されないことがあり、 データ行数が変わらない場合(前回0件クリア後に1件だけ取得した場合など)にDataBodyRange.Value代入が効かず、 テーブルにデータが書き込まれない不具合があった。 exportCSVDataToSheet/getRecordsDataToSheet/exportCSVDataToExistingTableの3箇所で、 一旦ヘッダ行のみにリサイズしてから目的のサイズにリサイズし直すことで回避。 調査用の詳細デバッグログ([DEBUG] records.count等)も合わせて追加。 Co-Authored-By: Claude Sonnet 5 <noreply@anthropic.com>
This commit is contained in:
parent
67b9f8c0f8
commit
a60244b7b0
@ -235,6 +235,9 @@ Function exportCSVDataToSheet(csvData As Variant, targetSheet As String)
|
|||||||
End If
|
End If
|
||||||
|
|
||||||
' テーブルにデータを追加(ヘッダ行(arr(0,*))を除いたデータ部分のみをDataBodyRangeに書き込む)
|
' テーブルにデータを追加(ヘッダ行(arr(0,*))を除いたデータ部分のみをDataBodyRangeに書き込む)
|
||||||
|
'直前と同一サイズへのResizeだとExcelがDataBodyRangeの内部状態を更新しないことがあるため、
|
||||||
|
'一旦ヘッダ行のみにリサイズしてから目的のサイズにリサイズし直す
|
||||||
|
tbl.Resize tbl.Range.Resize(1, maxCols)
|
||||||
tbl.Resize tbl.Range.Resize(rows.count, maxCols)
|
tbl.Resize tbl.Range.Resize(rows.count, maxCols)
|
||||||
|
|
||||||
Dim dataArr() As Variant
|
Dim dataArr() As Variant
|
||||||
@ -479,12 +482,16 @@ Function getRecordsDataToSheet(records As Collection, targetSheet As String)
|
|||||||
Exit Function
|
Exit Function
|
||||||
End If
|
End If
|
||||||
|
|
||||||
|
Debug.Print " [DEBUG] records.count = " & records.count
|
||||||
|
|
||||||
Dim flatRecords As New Collection
|
Dim flatRecords As New Collection
|
||||||
Dim rec As Dictionary
|
Dim rec As Dictionary
|
||||||
For Each rec In records
|
For Each rec In records
|
||||||
flatRecords.Add FlattenRecord(rec)
|
flatRecords.Add FlattenRecord(rec)
|
||||||
Next rec
|
Next rec
|
||||||
|
|
||||||
|
Debug.Print " [DEBUG] flatRecords.count = " & flatRecords.count
|
||||||
|
|
||||||
Dim headerDict As Dictionary
|
Dim headerDict As Dictionary
|
||||||
Set headerDict = flatRecords(1)
|
Set headerDict = flatRecords(1)
|
||||||
Dim headerKeys As Variant
|
Dim headerKeys As Variant
|
||||||
@ -492,6 +499,8 @@ Function getRecordsDataToSheet(records As Collection, targetSheet As String)
|
|||||||
Dim maxCols As Long
|
Dim maxCols As Long
|
||||||
maxCols = headerDict.count
|
maxCols = headerDict.count
|
||||||
|
|
||||||
|
Debug.Print " [DEBUG] maxCols = " & maxCols
|
||||||
|
|
||||||
Dim i As Long, j As Long
|
Dim i As Long, j As Long
|
||||||
Dim dataArr() As Variant
|
Dim dataArr() As Variant
|
||||||
ReDim dataArr(1 To flatRecords.count, 1 To maxCols)
|
ReDim dataArr(1 To flatRecords.count, 1 To maxCols)
|
||||||
@ -503,11 +512,16 @@ Function getRecordsDataToSheet(records As Collection, targetSheet As String)
|
|||||||
Next j
|
Next j
|
||||||
Next i
|
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
|
Dim tbl As ListObject
|
||||||
On Error Resume Next
|
On Error Resume Next
|
||||||
Set tbl = ws.ListObjects(targetSheet)
|
Set tbl = ws.ListObjects(targetSheet)
|
||||||
On Error GoTo 0
|
On Error GoTo 0
|
||||||
|
|
||||||
|
Debug.Print " [DEBUG] tbl Is Nothing (before) = " & (tbl Is Nothing)
|
||||||
|
|
||||||
Dim headerRange As Range
|
Dim headerRange As Range
|
||||||
Set headerRange = ws.Range("A1").Resize(1, maxCols)
|
Set headerRange = ws.Range("A1").Resize(1, maxCols)
|
||||||
For j = 0 To maxCols - 1
|
For j = 0 To maxCols - 1
|
||||||
@ -520,12 +534,23 @@ Function getRecordsDataToSheet(records As Collection, targetSheet As String)
|
|||||||
tbl.Name = targetSheet
|
tbl.Name = targetSheet
|
||||||
End If
|
End If
|
||||||
|
|
||||||
|
Debug.Print " [DEBUG] tbl.Range.Address (before resize) = " & tbl.Range.Address
|
||||||
|
|
||||||
If Not tbl.DataBodyRange Is Nothing Then
|
If Not tbl.DataBodyRange Is Nothing Then
|
||||||
tbl.DataBodyRange.ClearContents
|
tbl.DataBodyRange.ClearContents
|
||||||
End If
|
End If
|
||||||
|
|
||||||
|
'テーブル範囲が直前と同一サイズだとExcelがDataBodyRangeの内部状態を更新しないことがあるため、
|
||||||
|
'一旦ヘッダ行のみにリサイズしてから目的のサイズにリサイズし直す
|
||||||
|
tbl.Resize tbl.Range.Resize(1, maxCols)
|
||||||
tbl.Resize tbl.Range.Resize(flatRecords.count + 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
|
tbl.DataBodyRange.Value = dataArr
|
||||||
|
Debug.Print " [DEBUG] after assign, A2 cell value = [" & ws.Range("A2").Value & "]"
|
||||||
|
|
||||||
Debug.Print "レコードのシート出力完了: " & targetSheet
|
Debug.Print "レコードのシート出力完了: " & targetSheet
|
||||||
End Function
|
End Function
|
||||||
@ -680,6 +705,9 @@ Function exportCSVDataToExistingTable(csvData As Variant, tableName As String)
|
|||||||
tbl.DataBodyRange.ClearContents
|
tbl.DataBodyRange.ClearContents
|
||||||
End If
|
End If
|
||||||
|
|
||||||
|
'直前と同一サイズへのResizeだとExcelがDataBodyRangeの内部状態を更新しないことがあるため、
|
||||||
|
'一旦ヘッダ行のみにリサイズしてから目的のサイズにリサイズし直す
|
||||||
|
tbl.Resize tbl.Range.Resize(1, maxCols)
|
||||||
tbl.Resize tbl.Range.Resize(rows.count, maxCols)
|
tbl.Resize tbl.Range.Resize(rows.count, maxCols)
|
||||||
|
|
||||||
Dim dataArr() As Variant
|
Dim dataArr() As Variant
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user