may the VBA be with you

Excel VBAとか業務自動化とか

テキスト出力マクロ ができるまで その3

はじめに

前回、

vba-belle-equipe.hatenablog.com

  • フォーマットをテキストファイルとして作成
  • フォーマットの一部を置換する

というところまでいきました。

今回はその続きです。

フォーマット

f:id:vba-belle-equipe:20160322093223p:plain

「フォーマットシート」に設定してあり、

出力すると

[[名前]]は1個[[値段]]円の[[品物]]を[[個数]]個買いました。
全部でいくらでしょう。

正解:[[合計]]円

こんな感じでした。

設定

f:id:vba-belle-equipe:20160322092919p:plain

「操作盤」シートに設定してあります。

やりたいこと

とりあえず、[[名前]] を 太郎 にしてみましょう。

置換した文字列をファイルに出力

Sub test3()
  Dim filePath As String
  Dim ff As Long
  Dim maxRow As Long
  Dim i As Long
  filePath = "c:¥test¥test.txt"
  ff = FreeFile
  Open filePath For Output As #ff
  Sheets("フォーマット").Activate
  maxRow = Cells(Rows.Count, 1).End(xlUp).Row
  For i = 1 To maxRow
    Print #ff, Cells(i, 1)   ' << ここ、ここ
  Next
  Close #ff
End Sub

フォーマットシートの値をそのまま出していた部分を

  Print #ff, Replace(Cells(i, 1), "[[名前]]", "太郎")

に変えると

f:id:vba-belle-equipe:20160324114907p:plain

とりあえず、名前が「太郎」になりました。

他の設定も含めて置換する

名前だけではなく変えるものがたくさんあるので、Cells(i,1)を変数bufに入れて

  Dim buf As String

  For i = 1 To maxRow
    buf = Cells(i, 1)
    buf = Replace(buf, "[[名前]]", "太郎")
    buf = Replace(buf, "[[値段]]", "10")

                    :

    Print #ff, buf
  Next

こんな感じで繋げていけばできそうです。

ただ、若干ごちゃごちゃしますので、

外注する

文字列変換用のFunctionを作ると、全体がすっきりします。

Sub test3()
  Dim filePath As String
  Dim ff As Long
  Dim maxRow As Long
  Dim i As Long
  filePath = "c:¥test¥test.txt"
  ff = FreeFile
  Open filePath For Output As #ff
  Sheets("フォーマット").Activate
  maxRow = Cells(Rows.Count, 1).End(xlUp).Row
  For i = 1 To maxRow
    Print #ff, replaceText(Cells(i, 1))
  Next
  Close #ff
End Sub
Function replaceText(buf As String)
  buf = Replace(buf, "[[名前]]", "太郎")
  buf = Replace(buf, "[[値段]]", "10")
  buf = Replace(buf, "[[品物]]", "うまい棒")
  buf = Replace(buf, "[[個数]]", "8")
  buf = Replace(buf, "[[合計]]", "80")
  replaceText = buf
End Function

こんな感じですね。

結果

f:id:vba-belle-equipe:20160324121647p:plain

はい。置換できました。

あとは、「太郎」とかの値を「操作盤」シートから持ってこられるようにするだけです。

最終決戦前の準備

テキスト名を表示するテスト

初回に

Sub roopTest()
  Dim rootPath As String
  Dim filePath As String
  Dim maxCol As Long
  Dim j As Long
  
  Sheets("操作盤").Activate
  rootPath = Range("B1")
  maxCol = Cells(3, Columns.Count).End(xlToLeft).Column
  For j = 2 To maxCol
    filePath = rootPath & "¥" & Cells(3, j)
    Debug.Print filePath
  Next
End Sub

で、操作盤シートの「テキスト名」の部分だけ、イミディエイトウインドウに出せるようにしていました。

それを少し改良して、名前や性別等、他の項目も出してみましょう。

他の項目も表示するテスト

Sub roopTest2()
  Dim rootPath As String
  Dim filePath As String
  Dim maxCol As Long
  Dim i As Long, j As Long
  
  Sheets("操作盤").Activate
  rootPath = Range("B1")
  maxCol = Cells(3, Columns.Count).End(xlToLeft).Column
  For j = 2 To maxCol
    For i = 3 To 8
      Select Case i
        Case 3
          Debug.Print Cells(i, 1) & " = " & rootPath & "¥" & Cells(i, j)
        Case Else
          Debug.Print Cells(i, 1) & " = " & Cells(i, j)
      End Select
    Next i
    Debug.Print "/// 列が変わります ///"
  Next j
End Sub

横方向へのループに縦方向を追加しています。

テキスト名 = C:\test\a.txt
名前 = 太郎
性別 = 男
品物 = うまい棒
値段 = 10
個数 = 8
/// 列が変わります ///
テキスト名 = C:\test\b.txt
名前 = 花子
性別 = 女
品物 = あんずボー
値段 = 20
個数 = 5
/// 列が変わります ///
テキスト名 = C:\test\c.txt
名前 = ボブ
性別 = 男
品物 = ハートチップル
値段 = 30
個数 = 2
/// 列が変わります ///

これで、設定した値すべてにアクセスできるようになりました。

ので、あとはそれをうまいことあれして、

すれば完成です。