fix: テーブル書込みをDataBodyRangeプロパティに依存しない実装に全面変更
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>
This commit is contained in:
Kenichiro NOGI
parent
97f371db3f
commit
0544365276
@ -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
|
||||
|
||||
'テーブルのデータ部分をクリア
|
||||
If Not tbl.DataBodyRange Is Nothing Then
|
||||
tbl.DataBodyRange.ClearContents
|
||||
'既存データ部分を毎回クリア（DataBodyRangeプロパティは内部状態が更新されず
|
||||
'Nothingのままになることがあるため使わず、テーブル範囲から直接計算する）
|
||||
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
|
||||
|
||||
' テーブルにデータを追加（ヘッダ行(arr(0,*))を除いたデータ部分のみをDataBodyRangeに書き込む）
|
||||
'直前と同一サイズへのResizeだとExcelがDataBodyRangeの内部状態を更新しないことがあるため、
|
||||
'一旦ヘッダ行のみにリサイズしてから目的のサイズにリサイズし直す
|
||||
Dim tempRows As Long
|
||||
tempRows = tbl.Range.Rows.count + rows.count + 1
|
||||
tbl.Resize tbl.Range.Resize(tempRows, maxCols)
|
||||
' テーブルを目的のサイズにリサイズ
|
||||
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
|
||||
|
||||
'データ書き込み（DataBodyRangeプロパティを使わず、ヘッダ行の次からテーブル範囲を直接計算する）
|
||||
Dim dataRange As Range
|
||||
Set dataRange = tbl.Range.Resize(rows.count - 1, maxCols).Offset(1, 0)
|
||||
dataRange.Value = dataArr
|
||||
|
||||
'------------------------------------------
|
||||
Debug.Print "CSVデータをシートに出力完了: " & 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
|
||||
'既存データ部分を毎回クリア（DataBodyRangeプロパティは内部状態が更新されず
|
||||
'Nothingのままになることがあるため使わず、テーブル範囲から直接計算する）
|
||||
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
|
||||
|
||||
'テーブル範囲が直前と同一サイズだとExcelがDataBodyRangeの内部状態を更新しないことがあるため、
|
||||
'一旦ヘッダ行のみにリサイズしてから目的のサイズにリサイズし直す
|
||||
Dim tempRows As Long
|
||||
tempRows = tbl.Range.Rows.count + flatRecords.count + 2
|
||||
tbl.Resize tbl.Range.Resize(tempRows, 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 & "]"
|
||||
|
||||
'データ書き込み（DataBodyRangeプロパティを使わず、ヘッダ行の次からテーブル範囲を直接計算する）
|
||||
Dim dataRange As Range
|
||||
Set dataRange = tbl.Range.Resize(flatRecords.count, maxCols).Offset(1, 0)
|
||||
dataRange.Value = dataArr
|
||||
|
||||
Debug.Print "レコードのシート出力完了: " & 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 "データが存在しません（ヘッダのみ）: " & tableName, vbExclamation
|
||||
Debug.Print "データが0件のため、既存テーブルのデータ部分をクリアします: " & 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
|
||||
'既存データ部分を毎回クリア（DataBodyRangeプロパティは内部状態が更新されず
|
||||
'Nothingのままになることがあるため使わず、テーブル範囲から直接計算する）
|
||||
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
|
||||
|
||||
'直前と同一サイズへのResizeだとExcelがDataBodyRangeの内部状態を更新しないことがあるため、
|
||||
'一旦ヘッダ行のみにリサイズしてから目的のサイズにリサイズし直す
|
||||
Dim tempRows As Long
|
||||
tempRows = tbl.Range.Rows.count + rows.count + 1
|
||||
tbl.Resize tbl.Range.Resize(tempRows, maxCols)
|
||||
' テーブルを目的のサイズにリサイズ
|
||||
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
|
||||
|
||||
'データ書き込み（DataBodyRangeプロパティを使わず、ヘッダ行の次からテーブル範囲を直接計算する）
|
||||
Dim dataRange As Range
|
||||
Set dataRange = tbl.Range.Resize(rows.count - 1, maxCols).Offset(1, 0)
|
||||
dataRange.Value = dataArr
|
||||
|
||||
Debug.Print "CSVデータを既存テーブルに出力完了: " & tableName
|
||||
End Function
|
||||
|
||||
Loading…
Reference in New Issue
Block a user