VBAを使って1レコードごとに・・・の続きの質問

質問

本日5/12の10:41に質問させていただいたものの続きです。何度もすみません。

1レコードごとにカッコでくくってカンマをつける。

ここまでは教えていただいてウマくできたのですが、データの最後のカッコ閉じるの後だけ、カンマではなくセミコロンにすることってできますか？

つまり、こういうイメージです。
("01234",20,"あいうえお"),
("01235",40,"かきくけこ"),
("01236",60,"さしすせそ");

どうかよろしくご指導ください！！

回答No.3

KenKen_SP · ベストアンサー

> ...シングルクォーテーションをつけないカラムがある
> ...19項目あるカラムのうち３番目と５番目のカラムについてのみ

こんな感じでしょうか。

　　＜余談＞-----------------------------------------------------
　　こうような仕様変更が頻繁にあるのでしたら、井上さんのコードの
　　ように、カラムのデータ編集部分をサブルーチン化した方がコード
　　の可読性が向上し、その後の保守が非常に楽になります。
　　-------------------------------------------------------------

このコードは、セルの表示そのままのデータを書き出します。例えば、
2006/05/15 という日付データなら 2006/05/15 とそのまま書き出します。

何を心配しているかというと、、

実数 1.5268 のデータが Excel のセルに 1.53 と表示されていた場合、
このコードは 1.53 と書き出してしまいます。

この仕様で良いのでしょうか？

Sub OUTPUT_CSV_EX()

　　Dim FSO　　　 As Object
　　Dim TXS　　　 As Object
　　Dim rngTARGET As Range
　　Dim C　　　　 As Range
　　Dim lSROWNUM　As Long
　　Dim lEROWNUM　As Long
　　Dim i　　　　 As Long
　　Dim j　　　　 As Long
　　Dim strFN　　 As String
　　Dim strBUF　　As String

　　'フィールド区切り文字等の設定
　　Const PREFIX = "'"　　　'シングルクォーテーション
　　Const DELIMITER = ","　 'カンマ

　　'CSV出力する範囲の情報を設定
　　Set rngTARGET = ActiveSheet.UsedRange
　　With rngTARGET
　　　　lSROWNUM = .Row　　　　　　　　　 '開始行番号
　　　　lEROWNUM = .Row + .Rows.Count - 1 '終了行番号
　　End With

　　'出力する内容があるか確認
　　If IsEmpty(rngTARGET) Then
　　　　MsgBox "出力できる内容がありません", vbExclamation
　　　　Set rngTARGET = Nothing
　　　　Exit Sub
　　End If

　　'出力ファイル名生成（ブック名[シート名]出力時間）
　　strFN = ActiveWorkbook.Name
　　strFN = ActiveWorkbook.Path & "\" _
　　　　　　& Left$(strFN, Len(strFN) - 4) _
　　　　　　& "[" & ActiveSheet.Name & "]" _
　　　　　　& Format$(Now(), "yymmddhhmmss") & ".csv"

　　'CSV出力開始
　　On Error GoTo TERMINATE
　　Set FSO = CreateObject("Scripting.FileSystemObject")
　　Set TXS = FSO.CreateTextFile( _
　　　　　　　　Filename:=strFN, _
　　　　　　　　Overwrite:=True)

　　'開始行から最終行までループ処理
　　For i = lSROWNUM To lEROWNUM
　　　　'i行の列データを連結-----------------------------------
　　　　strBUF = "" '連結データ記憶用初期化
　　　　j = 1　　　 '列カウンタ初期化
　　　　For Each C In Intersect(ActiveSheet.Rows(i), rngTARGET)
　　　　　　Select Case j
　　　　　　　　Case Is = 3, 5 '3番目と5番目のカラムだけ
　　　　　　　　　　strBUF = strBUF & PREFIX & C.Text & PREFIX & DELIMITER
　　　　　　　　Case Else
　　　　　　　　　　strBUF = strBUF & C.Text & DELIMITER
　　　　　　End Select
　　　　　　j = j + 1
　　　　Next C
　　　　'------------------------------------------------------
　　　　'末尾の余分なカンマをカット
　　　　strBUF = Left$(strBUF, Len(strBUF) - 1)
　　　　'------------------------------------------------------
　　　　'最終行か判定する
　　　　If i = lEROWNUM Then
　　　　　　strBUF = "(" & strBUF & ");" '最終行の場合
　　　　Else
　　　　　　strBUF = "(" & strBUF & "),"
　　　　End If
　　　　'------------------------------------------------------
　　　　'テキスト書き出し
　　　　TXS.WriteLine strBUF
　　Next i

TERMINATE:
　　'後処理
　　TXS.Close
　　Set TXS = Nothing
　　Set FSO = Nothing
　　Set rngTARGET = Nothing
　　If Err.Number > 0 Then
　　　　MsgBox "Error:" & Err.Number & vbCrLf _
　　　　& Err.Description, vbCritical
　　End If

End Sub

お礼

ありがとうございます！
この方法で、狙っていた条件が設定できるようになりました！

伝えそびれや、私の言い回しが悪くてお伝えしきれなかった部分について、
１．先頭行については、見出し語句なので、「+ 1」を入れて2行目から開始することにしました。
　lSROWNUM = .Row + 1 '開始行番号

２．カラムの3番目と5番目だけに「'」を付け「ない」としたかったので、Caseの部分の書き込みを逆にして

Case Is = 3, 5 '3番目と5番目のカラムだけ
　　strBUF = strBUF & C.Text & DELIMITER
Case Else
strBUF = strBUF & PREFIX & C.Text & PREFIX & DELIMITER

これで全て解決できました♪ありがとうございました！

回答No.2

KenKen_SP

こんにちは。KenKen_SP です。

別システムとの連携で特殊フォーマットの CSV 出力が必要みたいですね。前回の流れの方法において、以下の２点について問題になりませんか？

1.　文字列の数字で先頭の 0 が外れてしまう
2.　データ型によりダブルコーテーションの有無がばらつく

　　例）01234　20　あいうえお　→　(1234,20,"あいうえお"),

現時点でこれが問題になるのかどうか不明ですから、ご質問分にある通り出力されるコードを書いてみました。

前回の流れからはずれてしまい、申し訳ありませんが、お試し下さい。

余談：
井上治さんのコードは機能的で美しいですね。私もいつも参考にさせていただいてます。

Sub OUTPUT_CSV_EX()

　　Dim FSO　　　 As Object
　　Dim TXS　　　 As Object
　　Dim rngTARGET As Range
　　Dim C　　　　 As Range
　　Dim lSROWNUM　As Long
　　Dim lEROWNUM　As Long
　　Dim i　　　　 As Long
　　Dim strFN　　 As String
　　Dim strBUF　　As String

　　'CSV出力する範囲
　　Set rngTARGET = ActiveSheet.UsedRange
　　With rngTARGET
　　　　lSROWNUM = .Row　　　　　　　　　 '開始行番号
　　　　lEROWNUM = .Row + .Rows.Count - 1 '終了行番号
　　End With
　　If IsEmpty(rngTARGET) Then
　　　　MsgBox "出力できる内容がありません", vbExclamation
　　　　Set rngTARGET = Nothing
　　　　Exit Sub
　　End If

　　'出力ファイル名生成
　　strFN = ActiveWorkbook.Path & "\" _
　　　　　　& ActiveSheet.Name & "_" & Format$(Now(), "yymmddhhmmss") & ".csv"

　　'CSV出力メイン
　　On Error GoTo TERMINATE
　　Set FSO = CreateObject("Scripting.FileSystemObject")
　　Set TXS = FSO.CreateTextFile( _
　　　　　　　　Filename:=strFN, _
　　　　　　　　Overwrite:=True)
　　For i = lSROWNUM To lEROWNUM
　　　　strBUF = ""
　　　　'列ごとのデータを連結
　　　　For Each C In Intersect(ActiveSheet.Rows(i), rngTARGET)
　　　　　　strBUF = strBUF & """" & C.Text & """" & ","
　　　　Next C
　　　　'末尾の余分なカンマをカット
　　　　strBUF = Left$(strBUF, Len(strBUF) - 1)
　　　　'最終行か判定
　　　　If i = lEROWNUM Then
　　　　　　strBUF = "(" & strBUF & ");"
　　　　Else
　　　　　　strBUF = "(" & strBUF & "),"
　　　　End If
　　　　TXS.WriteLine strBUF
　　Next i

TERMINATE:
　　TXS.Close
　　Set TXS = Nothing
　　Set FSO = Nothing
　　Set rngTARGET = Nothing
　　If Err.Number > 0 Then
　　　　MsgBox "Error:" & Err.Number & vbCrLf _
　　　　　　　 & Err.Description, vbCritical
　　End If

End Sub

補足

丁寧なご回答、ありがとうございます。
教えていただいた方法で、最後のカンマをセミコロンに変えることができました。ありがとうございます(^-^)

ですが、先述の続き・・・というのが実はポイントで、１．ダブルクォーテーションをシングルクォーテーションに変える。
２．シングルクォーテーションをつけないカラムがある。
という課題もあり、教えていただいた方法ではどこでカラム単位の編集方法を指定できるのか、初心者の私には難しいところです。。。
誠に恐縮ですが、その条件を足したコードを教えていただけますでしょうか？
ちなみに全部で19項目あるカラムのうち３番目と５番目のカラムについてのみ「’」囲いをしないことになっています。
どうぞよろしくお願い申し上げます。

回答No.1

BLUEPIXY

やり方は色々あると思いますが、その一つ
最初のデータ as Boolean
最初のデータ = true
Do while(データが有る間)
If 最初のデータ Then
最初のデータ = false
Else
"," & vbCrLf(改行) を出力
End If
通常のデータ処理をして、データの出力
Loop
";" & vbCrLf(改行) を出力

補足

ご回答ありがとうございます。
私は初心者なので、抜粋コードからの説明だとイメージが難しく、なかなかうまくできないでおります。
もうちょっと頑張ってみます。
取り急ぎお礼まで。