エクセル幼稚園：ワークシート上のデータを加工して、テキストファイルを出力

のようなデータがワークシート上にあったとき、B11セルの値のファイル名でテキストファイル"aaa.txt"を作成し、D11セルの値をop1、B14:B22セルの値をop2、C14:C22セルで項目ごとの合計をop3とする

cmd1 -op1 bbb -op2 ccc -op3 ddd

というコマンドをテキストファイルに出力するマクロを考えます。（説明が難しい。。）

上記のデータから出力されたテキストファイルは、このようになります。



1行目の"hoge hoge"は、ワークシート上のデータと関係なく、いつも出力される定型データです。2 - 5行目が、ワークシート上のデータを加工して出力されたコマンド行です。この処理をするために、１つのFunctionと、１つのSubを作りました。

01:Function UFCmd1(Range1, Range2, Range3 As String) As String
02:  ' 機能：引数で与えられたセル範囲のデータからコマンドの文字列を返す
03:  ' cmd1 -op1 bbb -op2 ccc -op3 ddd
04:  ' 引数
05:  ' Range1 : セル範囲(op1)
06:  ' Range2 : セル範囲(op2)
07:  ' Range3 : セル範囲(op3)
08:  Dim sum1 As Integer ' 合計(op3)
09:  ' op3の合計を出す
10:  sum1 = 0
11:  For Each objRANGE In Range(Range3).Cells
12:    sum1 = sum1 + objRANGE.Value
13:  Next
14:  ' コマンドの文字列を返す
15:  UFCmd1 = "cmd1 -op1 " & Range(Range1).Value & " -op2 " & Range(Range2).Value & " -op3 " & sum1
16:End Function

このFunctionは、op1, op2, op3の元データのセル範囲を文字列として受け取り、コマンド文字列を生成して返します。(Range型でセル範囲を渡そうとしたのですが、うまくいかず、String型で渡しています。）
8行目：sum1変数を整数変数(Integer)として宣言しています。
10行目：sum1変数に0を代入して初期化しています。
11-13行目：Range3で与えられたop3の元データのセル範囲の合計をsum1変数に代入します。
15行目：Range1のセル範囲の値をop1, Range2のセル範囲の値をop2, sum1変数の値をop3としてコマンド文字列を生成し、Functionの戻り値としています。

01:Sub aaa()
02:  ' 機能：エクセル上のデータを加工して、コマンドファイル（テキスト）を作成する
03:  Dim myRange1(3, 2) As String ' 元データのセル範囲
04:  Dim cmd2 As String ' コマンドの文字列
05:  Dim file1 As String ' ファイル名
06:  Dim nFNO As Integer 'ファイル番号
07:  Dim str1(2) As String ' 文字列
08:  Dim ans1 As Integer ' 答え
09:  Dim i As Integer ' For文用
10:  ' 元データ #0
11:  myRange1(0, 0) = "d11" ' セル範囲(op1)
12:  myRange1(0, 1) = "b14" ' セル範囲(op2)
13:  myRange1(0, 2) = "c14:c15" ' セル範囲(op3)
14:  ' 元データ #1
15:  myRange1(1, 0) = "d11" ' セル範囲(op1)
16:  myRange1(1, 1) = "b16" ' セル範囲(op2)
17:  myRange1(1, 2) = "c16:c18" ' セル範囲(op3)
18:  ' 元データ #2
19:  myRange1(2, 0) = "d11" ' セル範囲(op1)
20:  myRange1(2, 1) = "b19" ' セル範囲(op2)
21:  myRange1(2, 2) = "c19:c20" ' セル範囲(op3)
22:  ' 元データ #3
23:  myRange1(3, 0) = "d11" ' セル範囲(op1)
24:  myRange1(3, 1) = "b21" ' セル範囲(op2)
25:  myRange1(3, 2) = "c21:c22" ' セル範囲(op3)
26:  ' ファイル名を作成
27:  file1 = ThisWorkbook.Path & "\" & Range("b11").Value & ".txt"
28:  ' ファイルが存在する場合、上書きして良いか、確認する
29:  If Dir(file1) <> "" Then
30:    str1(0) = file1 & vbCrLf & "は存在します。" & vbCrLf
31:    str1(0) = str1(0) & "上書きしますか？"
32:    ' 上書きするか確認
33:    ans1 = MsgBox(str1(0), vbYesNo + vbExclamation + vbDefaultButton2)
34:    ' 場合分け
35:    Select Case ans1
36:      Case vbYes ' 「はい」
37:        ' ファイル書込みする(End If以降を実行)
38:      Case vbNo ' 「いいえ」
39:        ' ファイル書込みせず、Subを抜ける
40:        Exit Sub
41:      Case Else '「はい」でも「いいえ」でもない
42:        ' ファイル書込みせず、Subを抜ける
43:        Exit Sub
44:    End Select
45:  Else
46:    MsgBox (file1 & vbCrLf & "を作成します。")
47:  End If
48:  ' 使用可能なファイル番号を調べる
49:  nFNO = FreeFile()
50:  ' ファイルを開く
51:  Open file1 For Output As #nFNO
52:  ' ファイルへ書き込む
53:  Print #nFNO, "hoge hoge"
54:  For i = LBound(myRange1, 1) To UBound(myRange1, 1)
55:    If myRange1(i, 0) <> "" Then
56:      cmd2 = UFCmd1(myRange1(i, 0), myRange1(i, 1), myRange1(i, 2))
57:      Print #nFNO, cmd2
58:    End If
59:  Next
50:  ' ファイルを閉じる
61:  Close #nFNO
62:End Sub

このSubは、エクセル上のデータを加工して、コマンドファイル（テキスト）を作成します。
3-9行目：変数宣言
10-25行目：Functionを呼ぶときに必要となる３つのセル範囲をmyRange1配列に格納。
27行目：エクセルファイルが存在するフォルダのパス(ThisWorkbook.Path)に、B11セルの値と".txt"を加えて、作成するテキストファイルのフルパスの文字列を作成し、file1変数に代入。
29行目：Dir(file1) <> "" で、作成しようとしているファイルが既に存在しているか判定。
30-44行目：ファイルが既に存在している場合、上書きするか、処理を中断するか、人間に確認。（いわゆる、ばかよけ？）
46行目：ファイルが存在していない旨、人間に伝える。
49行目：使用可能なファイル番号を調べて、nFNO変数に代入。
51行目：テキストファイル（file1)を、ファイル番号：nFNO、モード：書き込み（Output)で開く。
53行目：ファイルへ、定型テキストを書き込み。
54-59行目：myRange1配列の1次元の添字の最小値(LBound)から、最大値(UBound)まで繰り返す。
55行目：セル範囲(op1)の文字列が空文字列でなかったら、56-57行目を実行。
56行目：UFCmd1関数を呼んで、コマンド文字列をcmd2変数に代入。
57行目：ファイルにコマンド文字列を出力。
61行目：ファイルを閉じる。

とりあえず、説明は、この辺でおしまい。。

タグ：エクセル VBA

コメント 4

nice! ありがとうございます。
誤記、ありますが、今日は不調なので、修正はおいおい。。
(*_*)ノ
by cheese999 (2012-07-17 20:31) 

Subの元データの誤記を訂正、Functionの説明を追加しました。
元データをSubの中に入れるか、入れないかは悩ましいところですね。
元データの数が多くなったら、別ファイルにすべきですが。。
ファイルが分かれるとファイル管理が面倒ですし。。
データがプログラムの中に入っていると、データ変更のたびにプログラムをいじることになり、バグ混入の原因になりますし。。
(*_*)ノ

by cheese999 (2012-07-18 04:49) 

ご訪問＆コメントありがとうございます＾＾
遅くなりまして　ごめんなさい<(_ _)>

そうですか...放射能の風評被害は困りものですね...
きれいな海なのでしょうね（＾＾）
行ってみたいですね...
by alba0101 (2012-07-18 12:18) 

alba0101さん、
どういたしまして。。。

沖縄の海に比べれば、おとりますが。。
いわき七浜で、一番いいのは、薄磯だったかと。。
(^_0)ノ
by cheese999 (2012-07-18 22:18)