may the VBA be with you

Excel VBAとか業務自動化とか

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

はじめに

前回、

vba-belle-equipe.hatenablog.com

全ての項目で置換する目途が立ちました。

シートおさらい

操作盤

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

フォーマット

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

作ってきたもの

これまで、

  1. 設定シートの各設定にアクセスするマクロ
  2. テキストを作成するマクロ
  3. テキストを置換するマクロ

を作ってきました。

構成

日本語でまとめると

<1>設定シートの各設定にアクセスする
    繰り返し---------------------
     | 列の設定を読み取る          >>設定
     | <2>テキストを作成する
     └--------------------------//列の数だけ     
<1>//

<2>テキストを作成する
    テキスト開く                 <<設定
    繰り返し---------------------------------
     | フォーマットシートの文字列を一行読み取る   >>文字列
     | 文字列を
     |   <3>テキストを置換する
     |   で置換して、テキストに一行書きだす
     └--------------------------------------//行の数だけ
    テキスト閉じる
<2>//

<3>テキストを置換する   <<文字列
    [[名前]]を置換する          <<設定
    [[品物]]を置換する          <<設定
    [[値段]]を置換する          <<設定
    [[個数]]を置換する          <<設定
    [[合計]]を置換する          <<設定
<3>//          >>文字列

こんな感じです(見やすいかはともかくとして)。

設定の受け渡し

注目するのは「設定」を 1 で読み取った後、 2 でも 3 でも使っているところです。

1 → 2 → 3 と引数を渡してもいいのですが、マクロ共通の変数に入れることで手間が軽減されます。

置換について

<3>テキストを置換する を見ると、名前、品物、値段、個数、合計が全て含まれた文字列を一気に置換するように見えます。

が、<2>を見るとわかる通り、実際には1行ずつ渡して受け取っています。

渡された文字列に置換対象が入っていない場合も特にエラーにならないので、特に問題ありませんが、

気になる場合は、

もし文字列に名前が含まれていたら
   名前を置換する

という風にしてもいいかなと思います。

あてはめる

もろもろ踏まえて、実際に組み合わせてみます。

Option Explicit

Dim rootPath As String
Dim テキスト名 As String
Dim 名前 As String
Dim 性別 As String
Dim 品物 As String
Dim 値段 As Long
Dim 個数 As Long

Sub makeTxtFiles()
  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
    テキスト名 = Cells(3, j)
    名前 = Cells(4, j)
    性別 = Cells(5, j)
    品物 = Cells(6, j)
    値段 = Cells(7, j)
    個数 = Cells(8, j)  
    Call textOut
  Next
End Sub

Sub textOut()
  Dim ff As Long
  Dim buf As String
  Dim maxRow As Long
  Dim i As Long
  Dim filePath As String
  
  filePath = rootPath & "¥" & テキスト名
  ff = FreeFile
  Open filePath For Output As #ff
  
  With Sheets("フォーマット")
    maxRow = .Cells(Rows.Count, 1).End(xlUp).Row
    For i = 1 To maxRow
      buf = .Cells(i, 1)
      buf = replaceText(buf)
      Print #ff, buf
    Next
  End With
  Close #ff
End Sub

Function replaceText(buf As String)
  buf = Replace(buf, "[[名前]]", 名前)
  buf = Replace(buf, "[[品物]]", 品物)
  buf = Replace(buf, "[[値段]]", 値段)
  buf = Replace(buf, "[[個数]]", 個数)
  buf = Replace(buf, "[[合計]]", 値段 * 個数)
  replaceText = buf
End Function

こんな感じでしょうか。

ちょっとだけ解説

makeTxtFiles の上に書いているものが、マクロ共通の変数といっていた部分です。

textOut でテキスト名を
replaceText で名前、品物、値段、個数を

引数として渡さずに使うことができます。

実行してみる

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

できました。

おまけ

呼び捨てよくない

せっかく性別を設定してるので、

Function replaceText(buf As String)
  Select Case 性別
    Case "男"
      buf = Replace(buf, "[[名前]]", 名前 & "君")
    Case "女"
      buf = Replace(buf, "[[名前]]", 名前 & "ちゃん")
  End Select

        :

End Function

これで、名前に「君」か「ちゃん」をつけられますね。

オートシェイプから実行

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

オートシェイプを右クリック → 「マクロの登録」をクリックして

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

マクロを選択してOKすれば、*1

オートシェイプをクリックしてマクロを実行することができます。

まとめ

いやあ、長かったですね。

あと、前回「最終決戦前の準備」とか言っていた部分が、結果的にあんまり関係なくなってちょっと笑いました。


マクロ作成は臨機応変に、ということで勘弁してください。

読んでくださった方、大変お疲れ様でした。

*1:画面はExcel2002のものです