以下のVBAのコードを改善して頂けないでしょうか。 このコードは以下のような流れになっています。

以下のVBAのコードを改善して頂けないでしょうか。 このコードは以下のような流れになっています。 ①Sheet1 の Cells(1,5).Value を Range("B1") に代入 (B1 の値が変わると Sheet2 の内容が変わるようになっています。) ②Sheet2 の内容をコピーしてテキスト形式で保存 ③Sheet2 の Cells(1,6).Value を Range("B1") に代入 (以下、繰り返し) Sub test() Dim i As Long i = 5 With ThisWorkbook.Worksheets("Sheet1") Do While .Cells(1, i).Value <> "" .Range("B1").Value = .Cells(1, i).Value Call test_sub i = i + 1 Loop End With MsgBox "完了しました" End Sub Sub test_sub() Dim filepath As String Application.ScreenUpdating = False ThisWorkbook.Worksheets("Sheet2").Copy With ActiveSheet filepath = ThisWorkbook.Path & "\" & Mid(.Range("A1").Value, 5) & ".yml" With .Parent .SaveAs filepath, xlText .Close False End With End With Application.ScreenUpdating = True sjis2utf8 filepath End Sub Sub sjis2utf8(filepath As String) Dim s As String With CreateObject("Scripting.FileSystemObject").OpenTextFile(filepath) s = .ReadAll .Close End With With CreateObject("ADODB.Stream") .Type = 2 .Charset = "UTF-8" .Open .WriteText s .SaveToFile filepath, 2 .Close End With End Sub このマクロを実行するとSheet2の内容をテキストファイルで出力してくれるのですが問題点があります。Sheet2 には - { name: Apple, color: red } のような形で記載している箇所が多くあるのですが、出力されたファイルは " - { name: Apple, color: red }" となっており、両端に二重引用符が付着してしまっています。 二重引用符が付着しないようにVBAのコードを改善して頂けないでしょうか。 Microsoft Forms 2.0 Object Library は参照可能にしてあります。 http://excel-magic.com/double-quotation/ 上記のサイトを確認すると二重引用符が付着しないようにするためには ・一度 Word に貼り付けてからテキスト形式で保存する ・マクロ内で直接クリップボードにコピーする などの解決方法があるようですが、実力不足で実現できていません。

補足

Sheet2内に二重引用符を意図的に記載している箇所はありませんので テキスト形式で保存したあと、保存したテキストファイルを開き、 テキスト全体から二重引用符を削除 または 二重引用符を空白に置換 の方法でも大丈夫です。

Visual Basic21閲覧xmlns="http://www.w3.org/2000/svg">50

ベストアンサー

0

こんにちは。 もし、「すべてのダブルクォーツを処理するのでもいい」 のだしたら、 s = replace(.ReadAll , chr(34) , "") のアイデア 1行ずつ処理したい、 なら、 With CreateObject("Scripting.FileSystemObject").OpenTextFile(filepath) s = .ReadAll .Close End With を set fso = CreateObject("Scripting.FileSystemObject") set f1 = fso.OpenTextFile(filepath) while not f1.eof s(i) = f1.readline if left(s(i),1) = chr(34) then redim s(i) s(i) = mid(s(i),2,len(s(i)-2) wend .Close 書き込みの場所 .WriteText join(s) のアイデアです。 ためしてみてください

それでしたら、最初のアイデア s = Replace(.ReadAll , chr(34) , "") で、試して見てください これ、一度ファイルからallで全部読み込みしてます。 置き換えしてから、変数sに代入することになります。 次のコントロールで、「空っぽ」の空間にwriteで流し込みし、 空間そのものを、文字コードを変更して保存という方法です スペースに置き換えるのなら、 s = Replace(.ReadAll , chr(34) , " ") です

ThanksImg質問者からのお礼コメント

ありがとうございます。うまく機能していました。助かりました。

お礼日時:4/20 14:10

その他の回答(1件)

0

こんにちは。 もし、「すべてのダブルクォーツを処理するのでもいい」 のだしたら、 s = replace(.ReadAll , chr(34) , "") のアイデア 1行ずつ処理したい、 なら、 With CreateObject("Scripting.FileSystemObject").OpenTextFile(filepath) s = .ReadAll .Close End With を set fso = CreateObject("Scripting.FileSystemObject") set f1 = fso.OpenTextFile(filepath) while not f1.eof s(i) = f1.readline if left(s(i),1) = chr(34) then redim s(i) s(i) = mid(s(i),2,len(s(i)-2) wend .Close 書き込みの場所 .WriteText join(s) のアイデアです。 ためしてみてください