エクセルVBA 集計ファイルの作り方①
どうもhiroakiです。
最近、以下のような記事を読みました。
コピペね笑笑
— hiroaki (@hiroakies) 2020年2月20日
期待されて異動した若手社員が酷評された理由 (東洋経済オンライン) https://t.co/AlEDb1xIQp #linenews
実は先日、私も同じような作業をして、大変な思いをしたので、コピペ作業を軽減するVBAを紹介したいと思います。
前提
先日、私がやった仕事は、当社が開く研修会の出席報告者の取りまとめです。
各会社から【研修会受講者名簿】というものが、エクセルファイルで送られてきますので、これを集計します。
ちなみに研修会は日程ごとに1班~4班あり、シート名に入れてもらっています。
研修会を開いてる側ですが、実際、10社20社となると集計作業がだいぶ面倒です(笑)
それだけではなく、時期が近づくと辞退者が出たり新たに参加したいという人が増えたりします。このように、いわゆる変更連絡というものがあれば、その都度名簿を作り直さなければいけません。
これ非常に面倒くさいんで(笑)、私の場合は、これらのファイルを開かずに一気に集計したいと思います。
方法
まず、下のように出席報告フォルダを用意します。
つぎに、そのフォルダ内に各会社より送られてきた受講者名簿のファイルを保存。集計ファイルを用意します。
集計ファイルには作業シートと出力シートを用意します。
画像の通りに作ります~説明は省きます~笑
出力シートはまっさらな状態です。※この線は気にしないでください。
作業シートの青いボタン(VBAが設定されています)を押すと、下のように出力シートに集計結果が出てきます。
以上です。
コピペの作業から解放されるので、少し楽ですね。
コード例
改良の余地ありですが、こんな感じで書きました。
- Sub 開く()
- Dim name As Range
- Dim name_worksheet As String
- Dim hanni As String
- Dim fn As String
- Dim wb As Workbook
- Dim n As Integer
- Worksheets("出力").Cells.Clear
- Worksheets("出力").Range("A1") = "ファイル名"
- Worksheets("出力").Range("B1") = "貼付け内容"
- Worksheets("作業").Activate
- name_worksheet = Worksheets("作業").Range("C1")
- hanni = Worksheets("作業").Range("D1")
- For Each name In Worksheets("作業").Range("A2").CurrentRegion
- fn = ThisWorkbook.Path & "¥" & name.Value & ".xlsx"
- On Error Resume Next
- Application.DisplayAlerts = False
- Set wb = Workbooks.Open(fn)
- If WorksheetFunction.CountBlank(Worksheets(name_worksheet).Range(hanni)) = Worksheets(name_worksheet).Range(hanni).Count Then
- Workbooks("集計ファイル.xlsm").Worksheets("出力").Range("B" & Rows.Count).End(xlUp).Offset(1, 0) = "空白です"
- Workbooks("集計ファイル.xlsm").Worksheets("作業").Activate
- Worksheets("出力").Range("B" & Rows.Count).End(xlUp).Offset(0, -1) = name.Value
- wb.Close
- Else
- Worksheets(name_worksheet).Range(hanni).Copy
- Workbooks("集計ファイル.xlsm").Worksheets("出力").Range("B" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial
- Workbooks("集計ファイル.xlsm").Worksheets("出力").Range("B" & Rows.Count).End(xlUp).Offset(0, -1) = name.Value
- n = -1
- Do Until n = 1
- If Workbooks("集計ファイル.xlsm").Worksheets("出力").Range("B" & Rows.Count).End(xlUp).Offset(n, -1) = "" Then
- Workbooks("集計ファイル.xlsm").Worksheets("出力").Range("B" & Rows.Count).End(xlUp).Offset(n, -1) = name.Value
- n = n - 1
- Else
- n = 1
- End If
- Loop
- wb.Close
- End If
- Next
- End Sub
標準モジュールへコピペして使ってみてください。
詳しい使い方や注意点はVBAの基礎的なことを踏まえて、次回以降また説明したいと思います。
質問等はお気軽にツイッターへどうぞ。
ではでは。