VBA CSV出力について

左のデータがエクセルに入力されている項目です。
マクロを使って右のようにCSV出力をさせたいと思っております。

重複するヘッダーレコードは一行にし、明細レコードは一行づつ出力させたいです。

エクセルに入力されている情報をまるまるCSV出力する方法は調べたら沢山のサンプルコードは出てきたのですが
今回のような出力のさせ方がわからず、ご教授いただけると幸いです。

No.3 ベストアンサー 回答者： tatsumaru77 回答日時： 2023/04/19 17:08

以下のマクロを標準モジュールに登録してください。

マクロは、シート：CSV出力の２行目以降を設定します。
1行目の見出しは、あなたが設定しておいてください。

Public Sub CSV出力()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim maxrow As Long
Dim row1 As Long
Dim row2 As Long
Dim key As String
Dim pkey As String: pkey = ""
Set ws1 = Worksheets("Sheet1")
Set ws2 = Worksheets("CSV出力")
maxrow = ws1.Cells(Rows.Count, 1).End(xlUp).Row
ws2.Rows("2:" & Rows.Count).ClearContents
row2 = 2
For row1 = 2 To maxrow
'ヘッダ作成
key = ws1.Cells(row1, "A").Value & "|" & ws1.Cells(row1, "B").Value & "|" & _
ws1.Cells(row1, "C").Value & "|" & ws1.Cells(row1, "D").Value & "|" & ws1.Cells(row1, "D").Value
'ヘッダ比較
If pkey <> key Then
'ヘッダが異なるならA～E列を設定
ws2.Cells(row2, "A").Resize(, 5).Value = ws1.Cells(row1, "A").Resize(, 5).Value
row2 = row2 + 1
End If
'F～G列を設定
ws2.Cells(row2, "F").Resize(, 2).Value = ws1.Cells(row1, "F").Resize(, 2).Value
row2 = row2 + 1
pkey = key
Next
MsgBox ("完了")
End Sub

この回答へのお礼

ありがとうございます。
無事解決できました！

お礼日時：2023/04/20 21:13

No.2 回答者： tatsumaru77 回答日時： 2023/04/19 16:15

No1です。

誤記訂正です。項番３は、以下が正しいです。No1の項番３は無視してください。

３．重複するヘッダーがない場合は、どのように出力しますか。
①1行にA列～G列まで出力する。
②1行にA列～H列まで出力し、次の行のG列にご契約者名を出力する。
①、②のどちらでしょうか。

この回答へのお礼

ご回答以下になります。
詳しく記載できておらず、すみません。

1．A列～E列までが、全て同じ場合に重複するヘッダーとしてみなしております。
2.重複するヘッダーは一つの塊になっております。
3.②にでお願いいたします。
4・左側がSeet1で、右側がCSV出力で処理していただけるとうれしいです。

お礼日時：2023/04/19 16:38

No.1 回答者： tatsumaru77 回答日時： 2023/04/19 16:12

補足要求です。

１．A列～F列までが、全て同じ場合に重複するヘッダーであると解釈して良いですか。
２．重複するヘッダーは、１つの塊になっていますか。
A列　（B列以降は省略）
111　．．．
111　．．．
111　．．．
222　．．．
222　．．．
222　．．．
ではなく
A列　（B列以降は省略）
111　．．．
111　．．．
222　．．．
111　．．．
222　．．．
222　．．．
のように並ぶことがありますかという質問です。

３．重複するヘッダーがない場合は、どのように出力しますか。
①1行にA列～G列まで出力
②1行にA列～H列まで出力し、次の行のG列にご契約者名を出力
①、②のど知多でしょうか。

４．左側のシートをSheet1、右側のシートをSheet2として処理して良いですか。