仕事でExcel上で解析した大量のデータをdatファイル形式で出力する必要が生じ、手動では時間がかかるため一括でdatファイルを出力するマクロを作成した。
今回はこのマクロに手を加え、任意のファイル形式(拡張子)のファイルを出力するマクロを作成した。
サンプル
今回使うサンプルは下記ボタンから入手可能である。
圧縮ファイルの中にはマクロ本体「exp11_comp.xlsm」と、テスト用のデータファイルが入っている。
まず「exp11_comp.xlsm」を開くと、次のような画面が表示される。
左上の「データファイルの取得」ボタンをクリックすると[参照]ダイアログボックスが開くので、解凍したフォルダ「Excel_Macro_Sample_11」の中にあるデータファイルを1つ、または複数選択し「OK」をクリックする。
「exp11_comp.xlsm」にファイルが取り込まれる。
次にセルG3に出力したいファイルのファイル形式(拡張子)を入力する。
上の画像の場合、セルG3には「dat」と入力されているため、2つのcsvファイルがdatファイルに変換される。
続いて「データファイル生成」ボタンをクリックすると、次のメッセージボックスが表示されるので「OK」をクリックする。
すると、データファイルの出力先を選択するための[参照]ダイアログボックスが開くので、適当な出力先フォルダを選択する。
出力が終了すると、次のメッセージボックスが表示される。
「はい」を押せば出力先のフォルダが表示され、出力されたデータファイルを確認することができる。
正しく出力されていれば上の画像のように、出力先のフォルダに出力前と同じ名前で、ファイル形式(拡張子)が変換されたファイルが保存されているはずである。
コード詳説
「exp11_comp.xlsm」は、以前作成したデータファイルの取り込みマクロ(下記記事参照)にデータファイル出力のマクロを追加したものである。
本記事ではデータファイル出力のマクロの解説を実施し、その他のマクロについては上記記事を参照されたい。
データファイル生成
マクロの中身は下記のようになっている。
Sub データファイル生成()
Dim FD As FileDialog
Dim NewFile As String
Dim MaxColumn As Long
Dim MaxRow As Long
Dim extn As Long
Dim c As Long
Dim r As Long
Dim i As Long
Dim j As Long
Dim k As Long
Dim MB As Integer
MsgBox Worksheets(1).Range("G3").Value & "ファイルを出力します。" & vbCrLf & _
"保存先のフォルダを指定してください。", vbOKOnly
Set FD = Application.FileDialog(msoFileDialogFolderPicker)
If FD.Show = True Then
For i = 2 To Worksheets.Count
With Worksheets(i).UsedRange
MaxRow = .Rows(.Rows.Count).Row
MaxColumn = .Columns(.Columns.Count).Column
End With
extn = InStrRev(Worksheets(i).Name, ".") - 1
WN = Left(Worksheets(i).Name, extn)
NewFile = FD.SelectedItems(1) & "\" & WN & "." & Worksheets(1).Range("G3").Value
Open NewFile For Output As #1
For r = 1 To MaxRow
For c = 1 To MaxColumn
If c <> MaxColumn Then
Print #1, Worksheets(i).Cells(r, c).Value & vbTab;
Else
Print #1, Worksheets(i).Cells(r, c).Value
End If
Next
Next
Close #1
Next
MB = MsgBox(Worksheets(1).Range("G3").Value & "ファイルを出力しました。" & vbCrLf & _
"保存先のフォルダを開きますか?", vbYesNo + vbQuestion)
If MB = vbYes Then
Shell "C:\Windows\Explorer.exe " & FD.SelectedItems(1), vbNormalFocus
End If
End If
End Sub
順番に見ていこう。
まず
MsgBox Worksheets(1).Range("G3").Value & "ファイルを出力します。" & vbCrLf & _
"保存先のフォルダを指定してください。", vbOKOnly
で最初のメッセージボックスを表示する。
セルG3を参照して、出力するファイル形式を表示するようにしている。
次はいつも通り
Set FD = Application.FileDialog(msoFileDialogFolderPicker)
If FD.Show = True Then
For i = 2 To Worksheets.Count
でダイアログボックスを変数に代入し、ダイアログボックスが表示された上で「OK」がクリックされたら、取り込まれたデータファイルの数だけFor~Next文で繰り返し処理を回す。
ここからは繰り返し処理の中身を見ていく。
まず
With Worksheets(i).UsedRange
MaxRow = .Rows(.Rows.Count).Row
MaxColumn = .Columns(.Columns.Count).Column
End With
で各データシートの有効セル範囲を調べ、最下段のセルの行数をMaxRow、最右端のセルの列数をMaxColumnに代入する。
次に出力するファイルのファイル名を設定する。
extn = InStrRev(Worksheets(i).Name, ".") - 1
WN = Left(Worksheets(i).Name, extn)
NewFile = FD.SelectedItems(1) & "\" & WN & "." & Worksheets(1).Range("G3").Value
まずInStrRev関数で、取り込んだデータファイルのファイル名を後方から探索して「.(ドット)」を見つけ、ファイル名の前方からドットまでの文字数-1の数を「extn」に代入する。
InStrRev(文字列1, 文字列2)
⇒ 文字列1を後方から数えて出現した文字列2の、前方から数えて出現するまでの文字数を返す。
(例) InStrRev(“Worksheets”, “e”)
⇒後方から数えると3文字目に「e」が初めて出現する。この「e」は前方から数えると8文字目に当たるため、返り値は「8」となる。
これでデータファイル名の内「.(拡張子)」以外の文字列の文字数が「extn」に代入される。
次に先ほど得た文字数を利用して、Left関数でデータファイル名の内「.(拡張子)」以外の文字列を抽出し、変数「WN」に代入する。
Left(文字列, 数値)
⇒ 与えた文字列の内、左から指定した数値分だけ文字数の文字列を返す。
(例) Left(“Worksheets”, 4) ⇒ Work
最後に「NewFile」に力するファイルのフルパスを代入する。
ここから本格的にデータファイルの作成工程に入る。
まず
Open NewFile For Output As #1
で指定したファイル形式のファイルを開く。
Open A For Output As #i
⇒ Aという名前のファイルを、書き込みモード(Output)で開く。
iは開いたファイルに振られる番号であり、今後はこの番号を介してファイルを操作する。
今回は2つのファイルを開いて同時並行で操作することはないため、i=1としている。
もし複数のファイルを同時並行で操作する場合は番号が重複しないようにする必要があり、その際は具体的な数値の代わりにFreeFile関数を用いる。
次に、開いたファイルにデータを書き込んでいく。
For r = 1 To MaxRow
For c = 1 To MaxColumn
If c <> MaxColumn Then
Print #1, Worksheets(i).Cells(r, c).Value & vbTab;
Else
Print #1, Worksheets(i).Cells(r, c).Value
End If
Next
Next
セルA1からスタートし、B1、C1…と書き込み、最終列まで書き込んだら改行してA2、B2、C2…と書き込む。
最終列に到達するまでは
Print #1, Worksheets(i).Cells(r, c).Value & vbTab;
でセル値とタブを入力していき、最終行のみ
Print #1, Worksheets(i).Cells(r, c).Value
でセル値のみ書き込んで改行する。
Print #i, 値または文字列;
⇒ i番目のファイルに値または文字列を書き込む。
末尾に「;」を付けると改行しない。
書き込みが終了したら
Close #1
でファイルを閉じる。
Close #i
⇒ i番目のファイルを閉じる。
以上の処理がデータファイルの数だけ繰り返される。
全てのデータファイルの出力が終了したら、
MB = MsgBox(Worksheets(1).Range("G3").Value & "ファイルを出力しました。" & vbCrLf & _
"保存先のフォルダを開きますか?", vbYesNo + vbQuestion)
で、変数に代入しつつ、保存先のフォルダを開くか否かを問うメッセージボックスを表示する。
そして
If MB = vbYes Then
Shell "C:\Windows\Explorer.exe " & FD.SelectedItems(1), vbNormalFocus
End If
で、メッセージボックスで「はい」を選択したときに保存先のフォルダを開くようにする。
Shell アプリケーションへのパス & 開くファイルまたはフォルダへのパス, vbNormalFocus
⇒ 特定のアプリケーションで、特定のファイルまたはフォルダを開く。
終わりに
今更だけど単にファイルの拡張子を変換するだけならフリーソフトで事足りるんだよな…
まぁ今回のマクロは「データ取り込み⇒編集⇒拡張子を変換して出力」の一連作業をExcel内で完結できるものとして意味があると思っておこう。
ソフトも作れるようになりたい…
END
コメント