![見出し画像](https://assets.st-note.com/production/uploads/images/94250182/rectangle_large_type_2_9c0bef8e350ada0868adf4ac6a90c3ba.jpeg?width=1200)
36歳からの未経験転職。仕事の中で、今まで学んだことを生かしていく軌跡①マクロでフォルダ内の複数ファイルデータを一つのファイルにまとめる
まずはじめに
大学卒業から10年ほど飲食店に勤務してあっという間に35歳。しかし、コロナを契機に世の中がどんどん変わっていく様をみてきて自身のこれからに不安を覚え、転職を志す。
晴れて転職したものの、どうやって学んだことを実務の中で生かしていくか考えないと意味がありません。本番はこれから。
一応VBAエキスパートスタンダードは取得しているものの実際の業務の中でマクロをどう使っていくか考え、プログラムを選びエラーがないようにカスタムしないといけません。
今回は手作業でやっていたフォルダ内の複数ファイルデータを一つのファイルにまとめる単調作業を、マクロでワンクリックで終わらすことを目指す。
やりたいこと説明
一つのフォルダ内に、現場でお客様から頂いたアンケートを日ごとに入力したファイルが複数あります。
![](https://assets.st-note.com/img/1672151622312-kmUEVjZQzD.png?width=1200)
アンケートを集計したファイルの内容は以下の通り。
アンケートの答えを一つ一つ数字で入力している「集計表」のシート。
その「集計表」のシートからcountifを使い集計結果を表示してるのが0903(日付)のシートです。この2つのシートからブックはできています。
![](https://assets.st-note.com/img/1672152445730-gA0CdBLlWj.png?width=1200)
![](https://assets.st-note.com/img/1672152479990-56zzbsYiKG.png?width=1200)
既存のやり方ではこれらのファイルの集計結果を一つのブックの新規シートにコピー&ペーストを繰り返し、またそれらを集計していました。一カ月で20個以上もあるのを毎月繰り返す作業。ただの無駄な単調作業です。
これをマクロでワンクリックで終わらすことを目指す。
マクロ作成手順
①まずはやりたいことをググってみる。
その結果パソコンスキルの教科書というサイトに以下のコードを見つける。
'プログラム0|変数設定の指定
Option Explicit
'プログラム1|プログラム開始
Sub GetExcelDataInFolder()
'プログラム2|シート設定
Dim ws1 As Worksheet
Set ws1 = ThisWorkbook.Worksheets("Sheet1")
'プログラム3|FileSystemObjectの設定
Dim fs As FileSystemObject
Set fs = New FileSystemObject
'プログラム4|対象フォルダを取得
Dim myfolder As Folder
Set myfolder = fs.GetFolder(ThisWorkbook.Path)
'プログラム5|対象フォルダ内の全ファイルを処理
Dim myfile As File
For Each myfile In myfolder.Files
'プログラム6|拡張子が「xlsx」のファイルのみを処理
If fs.GetExtensionName(myfile) = "xlsx" Then
'プログラム7|フォルダ内のエクセルを開いてシートを設定
Dim wb As Workbook
Set wb = Workbooks.Open(Filename:=myfile)
Dim ws2 As Worksheet
Set ws2 = wb.Worksheets(1)
'プログラム8|開いたエクセルの最終行を取得
Dim cmax As Long
cmax = ws2.Range("A65536").End(xlUp).Row
Debug.Print myfile.Name & "のcmax=" & cmax
'プログラム9|開いたエクセルのデータを転記
Dim i As Long
For i = 2 To cmax
Dim cmax1 As Long
cmax1 = ws1.Range("A65536").End(xlUp).Row
ws1.Range("A" & cmax1 + 1 & ":E" & cmax1 + 1).Value = ws2.Range("A" & i & ":E" & i).Value
Next
'プログラム10|エクセルを閉じる
wb.Close
'プログラム11|オブジェクト解放
Set ws2 = Nothing
Set wb = Nothing
End If
Next
'プログラム12|エクセルを保存
ThisWorkbook.Save
'プログラム13|オブジェクト解放
Set myfolder = Nothing
Set fs = Nothing
'プログラム14|プログラム終了
End Sub
このコードにはFileSystemObjectが使われています。私はこれを知りませんでしたが、通常あるオブジェクトではなく外部オブジェクトとのこと。
したがって、これを使うためにはまず準備が必要です。
VBEのツールから参照設定に進み、参照可能なライブラリファイルの中からMicrosoft Scripting Runtimeを探して、チェックを入れOKを押す。これでこの外部オブジェクトが使えるようにします。調べてみるとこのオブジェクトを使うと通常のコードよりフォルダやファイル操作のコードがかなり簡単になるとのこと。今回のコードに限らず汎用性高そうです。
![](https://assets.st-note.com/img/1672154406560-v3YLzz8hJk.png)
よし!!これでマクロ使えて楽ちん楽ちん!!!と思いますよね。でも実行してみるとエラーは勿論、使うための障害がでてきます。次はこれに対応していきます。
②抽出したいシートを変更
まず実行してみるとアンケートの集計結果ではなく、集計入力の方を抽出してしまっていたのでプログラム7の抽出ファイルの指定を(1)から(2)に変更します。これで結果の方を抽出するようになります。
'プログラム7|フォルダ内のエクセルを開いてシートを設定
Dim wb As Workbook
Set wb = Workbooks.Open(Filename:=myfile)
Dim ws2 As Worksheet
'抽出ファイルのシートを指定。ここを変更。
Set ws2 = wb.Worksheets(2)
③400エラーの原因を突き止め、対応する
次に400エラーがでてくる。これの原因を突き止めるのにかなり苦労しました…。
![](https://assets.st-note.com/img/1672156383893-EMbCRp5o1h.png?width=1200)
悪戦苦闘の末、エラー内容を突き止める方法がこちら。
'プログラム5|対象フォルダ内の全ファイルを処理
Dim myfile As File
For Each myfile In myfolder.Files
'myfileの指定がおかしいことを疑いmyfileの内容を表示。
Debug.Print myfile
これをすることによりイミディエイトウインドウにエラー時点でのmyfileの内容が表示されます。その結果エラーのときには、ファイル名の先頭に~$があるものが表示されました。なんじゃこりゃ?と調べたところ隠しファイルというもので、Excelファイルを開いているときに裏側で一時的に出来るファイルということ。実際にはないこの隠しファイルまで拾ってしまっていたのでエラーになっていたことを突き止める。こいつを除外しなければなりません。そこで以下のコードを足す。
If Left(myfile.Name, 2) <> "~$" Then
End If
こうすることによりファイル名に~$がないものだけを抽出するようになり、エラーはでなくなりました。
④マクロをより効率的に使えるようにコード追加
使ってみるとファイルを閉じる際に毎度毎度保存するかしないかの選択肢がでてくるのでこれを無くしたい。そこで以下のコードを足して選択肢表示を一時的に無しにしました。
Application.DisplayAlerts = False ' 保存確認させない.
Application.DisplayAlerts = True ' 保存確認する.
また、今のままだとマクロを実行すればするほど過去の抽出したものが貯まっていく。そこで最初に以下のコードを足して、まず初めに入力されているものをすべて消すことにしました。
'現在のシートを消す
Cells.clear
コード完成
すべてのコードを組み込んだ結果が下のコードになります。
抽出先のシート名も変更してます。
Option Explicit
'プログラム1|プログラム開始
Sub GetExcelDataInFolder()
'現在のシートを消す
Cells.clear
'プログラム2|シート設定
Dim ws1 As Worksheet
'抽出先のシート名入力
Set ws1 = ThisWorkbook.Worksheets("抽出")
'プログラム3|FileSystemObjectの設定
Dim fs As FileSystemObject
Set fs = New FileSystemObject
'プログラム4|対象フォルダを取得
Dim myfolder As Folder
Set myfolder = fs.GetFolder(ThisWorkbook.Path)
'プログラム5|対象フォルダ内の全ファイルを処理
Dim myfile As File
For Each myfile In myfolder.Files
'隠しファイルを表示し、それを回避する
Debug.Print myfile
If Left(myfile.Name, 2) <> "~$" Then
'プログラム6|拡張子が「xlsx」のファイルのみを処理
If fs.GetExtensionName(myfile) = "xlsx" Then
'プログラム7|フォルダ内のエクセルを開いてシートを設定
Dim wb As Workbook
Set wb = Workbooks.Open(Filename:=myfile)
Dim ws2 As Worksheet
'抽出ファイルのシートを指定
Set ws2 = wb.Worksheets(2)
'プログラム8|開いたエクセルの最終行を取得
Dim cmax As Long
cmax = ws2.Range("A65536").End(xlUp).Row
Debug.Print myfile.Name & "のcmax=" & cmax
'プログラム9|開いたエクセルのデータを転記
Dim i As Long
For i = 2 To cmax
Dim cmax1 As Long
cmax1 = ws1.Range("A65536").End(xlUp).Row
ws1.Range("A" & cmax1 + 1 & ":E" & cmax1 + 1).Value = ws2.Range("A" & i & ":E" & i).Value
Next
'プログラム10|エクセルを閉じる
Application.DisplayAlerts = False ' 保存確認させない.
wb.Close
'プログラム11|オブジェクト解放
Set ws2 = Nothing
Set wb = Nothing
End If
End If
Next
Application.DisplayAlerts = True ' 保存確認する.
'プログラム12|エクセルを保存
ThisWorkbook.Save
'プログラム13|オブジェクト解放
Set myfolder = Nothing
Set fs = Nothing
'プログラム14|プログラム終了
End Sub
これを実行した結果が以下のようになります。すべてのファイルの集計結果をずっと下まで貼り付けてくれています。
あとはこれをsumifで足していけばそれぞれの項目の数字の合計がでますのですべての集計結果合計を即座に調べられます。
![](https://assets.st-note.com/img/1672158725255-cCOHJUE8K9.png?width=1200)
最後に
実務が始まってからの初めての挑戦でしたが、なんとかコードを使えるようにカスタムすることができました。
今後も単調作業はマクロやパワークエリを使い楽ちんでできるようにすることを目指していき、アウトプットのためNote活用していきたいと思います。
引用、参考
この記事が気に入ったらサポートをしてみませんか?