fix: 営業所マスタExportを既存テーブルへの上書き専用に変更、新規シート・テーブル作成を廃止
exportCSVDataToSheetはtargetSheetと同名のテーブルを探す仕様のため、実際のテーブル名が一致せず新規シート・テーブルが作られてしまっていた。 exportCSVDataToExistingTableを新規追加し、テーブル名を問わず「営業所」シート上の既存テーブル(1つ目)に直接上書きする方式に変更。シート・テーブルが存在しない場合は新規作成せずエラー表示のみ。 Co-Authored-By: Claude Sonnet 5 <noreply@anthropic.com>
This commit is contained in:
parent
e455fe0a21
commit
6dc6ede9a9
@ -599,10 +599,81 @@ Sub SetupFilterSorterTables()
|
|||||||
End Sub
|
End Sub
|
||||||
|
|
||||||
'******************************************************************************
|
'******************************************************************************
|
||||||
'テーブルID 96243(営業所マスタ)をExport方式で全件取得し、「営業所」シートのテーブルを更新する
|
'既に存在するシート・テーブルにのみCSVデータ(ヘッダ行を除く)を上書きする。
|
||||||
'ソートはNumA昇順で固定。Filterは使用しない。ヘッダ行は「営業所」シートの既存テーブルのものをそのまま使い、
|
'テーブル名は問わずシート上の最初のテーブルを対象にする。シートやテーブルが存在しない場合は
|
||||||
'エクスポートしたCSVのヘッダ行(1行目)は捨てる(exportCSVDataToSheetは既存テーブルがある場合、
|
'新規作成せずメッセージを出して終了する
|
||||||
'ヘッダ行を書き換えずデータ部分のみ更新する仕様のため、これをそのまま利用する)
|
Function exportCSVDataToExistingTable(csvData As Variant, targetSheet As String)
|
||||||
|
Debug.Print "CSVデータを既存テーブルに出力開始: " & targetSheet
|
||||||
|
|
||||||
|
Dim ws As Worksheet
|
||||||
|
On Error Resume Next
|
||||||
|
Set ws = ThisWorkbook.Sheets(targetSheet)
|
||||||
|
On Error GoTo 0
|
||||||
|
|
||||||
|
If ws Is Nothing Then
|
||||||
|
MsgBox "シートが存在しません: " & targetSheet, vbExclamation
|
||||||
|
Exit Function
|
||||||
|
End If
|
||||||
|
|
||||||
|
If ws.ListObjects.count = 0 Then
|
||||||
|
MsgBox "テーブルが存在しません: " & targetSheet, vbExclamation
|
||||||
|
Exit Function
|
||||||
|
End If
|
||||||
|
|
||||||
|
Dim tbl As ListObject
|
||||||
|
Set tbl = ws.ListObjects(1)
|
||||||
|
|
||||||
|
Dim i As Long, j As Long
|
||||||
|
Dim arr() As Variant
|
||||||
|
Dim maxCols As Long
|
||||||
|
|
||||||
|
Dim rows As Collection
|
||||||
|
Set rows = ParseCsv(csvData)
|
||||||
|
|
||||||
|
If rows.count <= 1 Then
|
||||||
|
MsgBox "データが存在しません(ヘッダのみ): " & targetSheet, vbExclamation
|
||||||
|
Exit Function
|
||||||
|
End If
|
||||||
|
|
||||||
|
maxCols = 0
|
||||||
|
Dim rowArr As Variant
|
||||||
|
For Each rowArr In rows
|
||||||
|
If UBound(rowArr) + 1 > maxCols Then
|
||||||
|
maxCols = UBound(rowArr) + 1
|
||||||
|
End If
|
||||||
|
Next rowArr
|
||||||
|
|
||||||
|
ReDim arr(0 To rows.count - 1, 0 To maxCols - 1)
|
||||||
|
|
||||||
|
i = 0
|
||||||
|
For Each rowArr In rows
|
||||||
|
For j = LBound(rowArr) To UBound(rowArr)
|
||||||
|
arr(i, j) = rowArr(j)
|
||||||
|
Next j
|
||||||
|
i = i + 1
|
||||||
|
Next rowArr
|
||||||
|
|
||||||
|
If Not tbl.DataBodyRange Is Nothing Then
|
||||||
|
tbl.DataBodyRange.ClearContents
|
||||||
|
End If
|
||||||
|
|
||||||
|
tbl.Resize tbl.Range.Resize(rows.count, maxCols)
|
||||||
|
|
||||||
|
Dim dataArr() As Variant
|
||||||
|
ReDim dataArr(1 To rows.count - 1, 1 To maxCols)
|
||||||
|
For i = 1 To rows.count - 1
|
||||||
|
For j = 1 To maxCols
|
||||||
|
dataArr(i, j) = arr(i, j - 1)
|
||||||
|
Next j
|
||||||
|
Next i
|
||||||
|
tbl.DataBodyRange.Value = dataArr
|
||||||
|
|
||||||
|
Debug.Print "CSVデータを既存テーブルに出力完了: " & targetSheet
|
||||||
|
End Function
|
||||||
|
|
||||||
|
'テーブルID 96243(営業所マスタ)をExport方式で全件取得し、「営業所」シートの既存テーブルを更新する
|
||||||
|
'ソートはNumA昇順で固定。Filterは使用しない。ヘッダ行は既存テーブルのものをそのまま使い、
|
||||||
|
'エクスポートしたCSVのヘッダ行(1行目)は捨てる。新規シート・テーブルの作成は行わない
|
||||||
Sub runSalesOfficeExport()
|
Sub runSalesOfficeExport()
|
||||||
Call init
|
Call init
|
||||||
|
|
||||||
@ -620,6 +691,6 @@ Sub runSalesOfficeExport()
|
|||||||
If IsEmpty(resData) Or resData = "" Then
|
If IsEmpty(resData) Or resData = "" Then
|
||||||
Debug.Print "データが取得できませんでした"
|
Debug.Print "データが取得できませんでした"
|
||||||
Else
|
Else
|
||||||
Call exportCSVDataToSheet(resData, "営業所")
|
Call exportCSVDataToExistingTable(resData, "営業所")
|
||||||
End If
|
End If
|
||||||
End Sub
|
End Sub
|
||||||
Loading…
Reference in New Issue
Block a user