シート内容の文字列を置換してVBAでCSV出力する方法

Question

質問内容の画像を添付いたします。

SHEET1のエクセルのデータをもとに
SHEET1変換イメージに文字を置換、行の追加を実施
最後に変換後をＣＳＶ出力する。

★ご質問させていただきたい内容
1点目
画像のシート1について
５行目のレコードですが、C4,D4,E4,...最終列をもとに
Sheet1変換イメージのように行を追加する方法

2点目
「○」であれば01に置換「×」であれば02に置換する。

ＣＳＶ出力についてはネットでググりながら出力することができたのですが、
文字列を追加したり、行を追加したりなどの方法がわからず、ご教授お願いいたします。

Qchan1962 · Accepted Answer

こんばんは、
ご質問の回答ではありません。
少し気になったのは01　02　
これをただセルに書き込むと1とか2になってしまうと思いました
データ加工（操作）をシート経由でCSVにする場合、少し面倒ではないかと、、
'を付けておけば良いだけかもしれませんが、、

シートで目視する必要がないのなら、直接CSVに出来るデータを作成する方が良いかも、、と思います。
スキルをお持ちと思いますので　サンプルで示します。

Sub CSV_Text()
    Dim csvData As String
    Dim lineData As String
    Dim pointKey As String
    Dim TrgRange As Range, R As Range, CEL As Range
    With ActiveSheet
        With .Range("A5").CurrentRegion
            Set TrgRange = Intersect(.Cells, .Offset(1).Cells)
        End With
        csvData = ""
        For Each R In TrgRange.Rows    ' 行ループ
            For Each CEL In R.Columns
                If CEL.Value = "○" Or CEL.Value = "×" Then
                    If CEL.Value = "○" Then
                        pointKey = "01"
                    Else
                        pointKey = "02"
                    End If
                    lineData = .Cells(CEL.Row, 1) & "," & .Cells(CEL.Row, 2) & "," & .Cells(4, CEL.Column) & "," & pointKey
                    If csvData = "" Then
                        csvData = lineData
                    Else        '改行
                        csvData = csvData & vbCrLf & lineData
                    End If
                End If
            Next
        Next
    End With

Worksheets("Sheet2").Range("A1") = csvData    ' CSV に書き込む全データ
End Sub

csvDataをOpenTextFileなどでcsv保存すればcsv作成できると思います。
サンプル

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)    ' CSV書き込み
    TS.Close
    Set TS = Nothing
    Set fso = Nothing
End Sub

Qchan1962 · Answer

こんにちは
＃２の
Sub CSV_Text()　と
Sub FSO_csv(csvData As String)が同じ標準モジュールに書いてあるとして
Sub CSV_Text()の行末前の
Worksheets("Sheet2").Range("A1") = csvDataを置き換えるか
又は、次の実行行に
Sub FSO_csv(csvData As String)を呼びます
方法はCall します。

Next　　'既存コード
End With　'既存コード
'Worksheets("Sheet2").Range("A1") = csvData '（不要なら削除）
Call FSO_csv(csvData)
End Sub

＞参照設定からMicrosoft Scripting Runtimeをクリックして外部ライブラリーを参照できるようにしたのですが

Set fso = CreateObject("Scripting.FileSystemObject")
実行時バインディングにしてありますので事前の参照は不要です。
（デメリットは作成時プロパティ参照などが出来ないのと、実行速度が少し遅いくらい？と解釈しています）

housyasei-usagi · Answer

ダサいけど例えばこれ

sheet2はあらかじめ準備して書式も文字列にしてください。

データ数わからないのでとりあえず例にあわせてます。
縦は空白でおしまい。

Sub test()
r = 5
rr = 1
 
For r = 5 To 100　　'縦のデータ数により変更
    If Cells(r, 1) = "" Then Exit Sub
For c = 3 To 5　　'横のデータ数により変更
    If Cells(r, c) = "〇" Then
        Sheets("Sheet2").Cells(rr, 1) = Cells(r, 1)
        Sheets("Sheet2").Cells(rr, 2) = Cells(r, 2)
        Sheets("Sheet2").Cells(rr, 3) = Cells(4, c)
        Sheets("Sheet2").Cells(rr, 4) = "01"
           
    End If
   
    If Cells(r, c) = "×" Then
        Sheets("Sheet2").Cells(rr, 1) = Cells(r, 1)
        Sheets("Sheet2").Cells(rr, 2) = Cells(r, 2)
        Sheets("Sheet2").Cells(rr, 3) = Cells(4, c)
    Sheets("Sheet2").Cells(rr, 4) = "02"
    End If
   
    rr = rr + 1
Next
Next
End Sub

シート内容の文字列を置換してVBAでCSV出力する方法

こんばんは、

こんにちは

ダサいけど例えばこれ

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

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

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

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