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

Question

元の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保存するコードを教えて頂けないでしょうか？

Qchan1962 · Accepted Answer

やっぱり、
成り行きなので割愛しようと思いましたが、サンプルは多い方が良いかも、、と　書き直してみました
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

Qchan1962 · Answer

こんばんは、
＞加工の為に左の列に作業列を挿入するため
＞更に、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

Qchan1962 · Answer

＃１です
寝る前でしたので、思考が停止していたような、、回答でした。
作業列の入り方が良く分からず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など対策が必要かも、、です。

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

Qchan1962 · Answer

＃２です
＞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用文字列)とした方が早いような気がします。

Qchan1962 · Answer

"vbLf" はダブルクォーテーションを取らないといけないですよね？
はい。
コピペしてしまい失敗しました。

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

こんばんは、

＃１です

＃２です

やっぱり、

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

似たような質問が見つかりました

このQ&Aを見た人はこんなQ&Aも見ています

関連するカテゴリからQ&Aを探す

このQ&Aを見た人がよく見るQ&A

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング