テキスト出力マクロ ができるまで その4
シートおさらい
操作盤
フォーマット
作ってきたもの
これまで、
- 設定シートの各設定にアクセスするマクロ
- テキストを作成するマクロ
- テキストを置換するマクロ
を作ってきました。
構成
日本語でまとめると
<1>設定シートの各設定にアクセスする 繰り返し--------------------- | 列の設定を読み取る >>設定 | <2>テキストを作成する └--------------------------//列の数だけ <1>// <2>テキストを作成する テキスト開く <<設定 繰り返し--------------------------------- | フォーマットシートの文字列を一行読み取る >>文字列 | 文字列を | <3>テキストを置換する | で置換して、テキストに一行書きだす └--------------------------------------//行の数だけ テキスト閉じる <2>// <3>テキストを置換する <<文字列 [[名前]]を置換する <<設定 [[品物]]を置換する <<設定 [[値段]]を置換する <<設定 [[個数]]を置換する <<設定 [[合計]]を置換する <<設定 <3>// >>文字列
こんな感じです(見やすいかはともかくとして)。
設定の受け渡し
注目するのは「設定」を 1 で読み取った後、 2 でも 3 でも使っているところです。
1 → 2 → 3 と引数を渡してもいいのですが、マクロ共通の変数に入れることで手間が軽減されます。
あてはめる
もろもろ踏まえて、実際に組み合わせてみます。
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 で名前、品物、値段、個数を
引数として渡さずに使うことができます。
実行してみる
できました。
おまけ
呼び捨てよくない
せっかく性別を設定してるので、
Function replaceText(buf As String) Select Case 性別 Case "男" buf = Replace(buf, "[[名前]]", 名前 & "君") Case "女" buf = Replace(buf, "[[名前]]", 名前 & "ちゃん") End Select : End Function
これで、名前に「君」か「ちゃん」をつけられますね。
まとめ
いやあ、長かったですね。
あと、前回「最終決戦前の準備」とか言っていた部分が、結果的にあんまり関係なくなってちょっと笑いました。
マクロ作成は臨機応変に、ということで勘弁してください。
読んでくださった方、大変お疲れ様でした。
*1:画面はExcel2002のものです