【Excel VBA】カンマと改行コードを取り除くマクロ

元のExcelデータがA～R列まであり、それを加工してCSV形式で保存して納品する業務なのですが、
データ内に半角カンマ「,」が紛れ込んでいる可能性があります。
このままCSV保存すると、カンマの数が増える為に列がずれてしまいます。

また、セル内改行コードが混入している場合があり、同じくCSV保存すると
開いた時にレイアウトが崩れてしまいます。

これらの対応として手作業で以下の操作をしています。
・G列とH列のみ半角カンマ「,」→全角句読点「、」に置換
・シート全体(もしくはA～R列)内の改行コード(Ctrl+J)を削除

しかし理由は不明なのですが、置換で(Ctrl+J)をnullに置き換えたのに、
CSV保存した後に確認すると不要な場所で改行されてしまっている場合があります。
「Ctrl+J」と違うコードが存在するのでしょうか？(単なる手作業ミスかもしれません)
とりあえず上記のカンマの置換作業と、Ctrl+Jを削除する作業をマクロで行えば見落としもなくなるのかなと思いまして。

また、加工の為に左の列に作業列を挿入するため、A～R列が、I～Z列にずれますので(A～H列が作業列)、
更に、1行目の項目名の行もCSV保存する時は不要なため、
2行目以降、I～Z列の部分をCSV保存したいです。(結果的にA～R列のCSVになる)

上記、置換と削除のコードと、
指定範囲だけ対象にCSV保存するコードを教えて頂けないでしょうか？

質問者からの補足コメント

• 

  ありがとうございます。
  "vbLf" はダブルクォーテーションを取らないといけないですよね？
  まだ引き続き、検証中です。
  非常に助かります。

  No.4の回答に寄せられた補足コメントです。 補足日時：2021/07/14 11:19

No.4 ベストアンサー 回答者： Qchan1962 回答日時： 2021/07/13 19:02

やっぱり、

成り行きなので割愛しようと思いましたが、サンプルは多い方が良いかも、、と　書き直してみました
Sub make_csv()
Dim csvData As String ' CSV に書き込む全データ
Dim lineData As String
Dim TrgRange As Range
Dim R As Range, Cell As Range
With ActiveSheet
Call .Range("G:H").Replace(What:=",", Replacement:="，", LookAt:=xlPart, MatchCase:=True)
Call .UsedRange.Replace(What:=",", Replacement:="", LookAt:=xlPart, MatchCase:=True)
Call .UsedRange.Replace(What:="vbLf", Replacement:="", LookAt:=xlPart, MatchCase:=True)
' 見出し行を取り除く対象範囲
Set TrgRange = .Range("I2", Cells(Rows.Count, "Z").End(xlUp))
End With
For Each R In TrgRange.Rows ' 行ループ
lineData = ""
For Each Cell In R.Columns ' 列ループ
If lineData = "" Then
lineData = Cell.Value
Else
lineData = lineData & "," & Cell.Value
End If
Next
If csvData = "" Then
csvData = lineData
Else '改行
csvData = csvData & vbCrLf & lineData
End If
Next
Call FSO_csv(csvData)
End Sub

Sub FSO_csv(csvData As String)
Dim fso As Object, TS As Object ' TextStream
Set fso = CreateObject("Scripting.FileSystemObject")
Dim ex_csvPath As String, ex_csvFileName As String
ex_csvPath = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\"
ex_csvFileName = "TEST.csv"

Set TS = fso.OpenTextFile(Filename:=ex_csvPath & ex_csvFileName, _
IOMode:=2, Create:=True)
TS.Write (csvData) ' 書き込み
TS.Close
Set TS = Nothing
Set fso = Nothing
End Sub

この回答へのお礼

ありがとうございます。
助かりましたし、勉強になりました。

お礼日時：2021/07/21 15:21

No.5 回答者： Qchan1962 回答日時： 2021/07/14 15:02

"vbLf" はダブルクォーテーションを取らないといけないですよね？

はい。
コピペしてしまい失敗しました。

No.3 回答者： Qchan1962 回答日時： 2021/07/13 19:00

＃２です

＞dataRow = 2　の行の下に、
「With ActiveSheet　～　End With」文を挿入すればと考えてます。
大丈夫だと思いますが、With Worksheets(sheet_name)の中（次の行）に入れるのであれば、With ActiveSheetとEnd Withは不要です。
＞改行削除は
中のCall文1行を複製して、「What:=vbLf」にすれば良いでしょうか。
ですね。
＞すると以下のReplace分は重複処理で意味がないけどそのままでもOK
TS.Write Replace(Replace(Worksheets(sheet_name).Cells(dataRow, i).Value, vbLf, ""), ",", "、") & "," ' レコードを出力
確かに無駄ですので
TS.Write Worksheets(sheet_name).Cells(dataRow, i).Value & ","
でOKかな。

Replaceがメインのご質問と思い、添削コードで参考になればと回答してしまいましたが、少し変かも知れません。
End Withの位置をTS.Closeの後でもOKだと思います。
その場合、
TS.Write .Cells(dataRow, i).Value & ","


CSV出力を考えると、、CSVは区切り文字で区切られたテキストなので
ループ内でCSV用の文字列を作って
一度に　TS.Write (csv用文字列)とした方が早いような気がします。

No.2 回答者： Qchan1962 回答日時： 2021/07/13 17:40

＃１です

寝る前でしたので、思考が停止していたような、、回答でした。
作業列の入り方が良く分からずCSV出力のみを考えていたようです。

＞・G列とH列のみ半角カンマ「,」→全角句読点「、」に置換
＞・シート全体(もしくはA～R列)内の改行コード(Ctrl+J)を削除

With ActiveSheet
Call .Range("G:H").Replace(What:=",", Replacement:="，", LookAt:=xlPart, MatchCase:=True)
Call .UsedRange.Replace(What:=",", Replacement:="", LookAt:=xlPart, MatchCase:=True)
End With
こんな感じでどうでしょう？
.UsedRange　使用されている範囲を指定しています。

Replaceメソッドなので遅めの処理になります
Application.ScreenUpdatingなど対策が必要かも、、です。

少し気になるのは、他のフォーマットなどは大丈夫なのかな、、数値のみのセルや日付、時間など、、別の話ですね。

この回答へのお礼

ありがとうございます。

dataRow = 2　の行の下に、
「With ActiveSheet　～　End With」文を挿入すればと考えてます。

改行削除は
中のCall文1行を複製して、「What:=vbLf」にすれば良いでしょうか。

すると以下のReplace分は重複処理で意味がないけどそのままでもOK
TS.Write Replace(Replace(Worksheets(sheet_name).Cells(dataRow, i).Value, vbLf, ""), ",", "、") & "," ' レコードを出力

または、
TS.Write

だけでも良いのでしょうか？
完成に近づいてきました。
よろしくお願いいたします<m(__)m>

お礼日時：2021/07/13 18:03

No.1 回答者： Qchan1962 回答日時： 2021/07/13 02:48

こんばんは、

＞加工の為に左の列に作業列を挿入するため
＞更に、1行目の項目名の行もCSV保存する時は不要なため、

加工もVBAで行えば良いように思いますが、、
＞2行目以降、I～Z列の部分をCSV保存したいです。

手元にある使い廻しコードですが、ご質問に合わせて
変えてみました。参考になりますか、、

FSOに関しては、他の処理の為に採用していますが、
処理速度などの問題があるようでしたら、CreateObject("ADODB.Stream")など、他の方法に書き直してください。

Sub Sample()
Dim ex_csvPath As String, ex_csvFileName As String, sheet_name As String
ex_csvPath = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\"
ex_csvFileName = "TEST.csv"
sheet_name = "test"
Call FSO_Ex_CSV(ex_csvPath, ex_csvFileName, sheet_name)
End Sub

Sub FSO_Ex_CSV(ex_csvPath As String, ex_csvFileName As String, sheet_name As String)
Dim fso As Object, TS As Object ' TextStream
Set fso = CreateObject("Scripting.FileSystemObject")
Dim strREC() As String
Dim MaxRow As Long, i As Long
Dim dataRow As Long ', Maxcol As Long
dataRow = 2
With Worksheets(sheet_name)
MaxRow = .Cells(Rows.Count, "I").End(xlUp).Row
If .FilterMode Then .ShowAllData
End With
Set TS = fso.OpenTextFile(Filename:=ex_csvPath & ex_csvFileName, _
IOMode:=2, Create:=True) 'ForWriting
Do Until dataRow > MaxRow
For i = 9 To 26 'Maxcol
TS.Write Replace(Replace(Worksheets(sheet_name).Cells(dataRow, i).Value, vbLf, ""), ",", "、") & "," ' レコードを出力
Next i
TS.WriteLine '改行
dataRow = dataRow + 1
Loop
TS.Close
Set TS = Nothing
Set fso = Nothing
End Sub

この回答へのお礼

ありがとうございます。動作確認しました。
せいぜい1,000行位で、処理速度も気にする必要なさそうです。
置換後の文字が句読点「、」じゃなくて全角カンマ「，」でしたのでソースを直しました。

あと、G列とH列のカンマを全角化の後、
シート全体から半角カンマを取り除きたいのです。
そうすればG列とH列からカンマは消えないはず。
他の列の半角カンマ混入も取り除きたいです。

可能ならお願いなのですが、
置換作業をシート内に反映した後に
↓
CSV保存
の順番に出来ないでしょうか？

半角カンマや改行コードは、エラー条件になるため元のブックも解消した上で保管しておきたいのです。(書き出すCSVだけ直したいのではない)
すみません。

お礼日時：2021/07/13 16:55