【Excelマクロ】任意のファイル形式(拡張子)のファイルを出力するマクロ

Excelマクロ

 仕事でExcel上で解析した大量のデータをdatファイル形式で出力する必要が生じ、手動では時間がかかるため一括でdatファイルを出力するマクロを作成した。

 今回はこのマクロに手を加え、任意のファイル形式(拡張子)のファイルを出力するマクロを作成した。

Microsoft Excel 2019の利用を想定しています。

サンプル

 今回使うサンプルは下記ボタンから入手可能である。

 

 圧縮ファイルの中にはマクロ本体「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

コメント

タイトルとURLをコピーしました