気ままに趣味旅行

面白いコト「拡がる/拡げる」

エクセルVBA 集計ファイルの作り方①

どうもhiroakiです。

最近、以下のような記事を読みました。

実は先日、私も同じような作業をして、大変な思いをしたので、コピペ作業を軽減するVBAを紹介したいと思います。

 

前提

先日、私がやった仕事は、当社が開く研修会の出席報告者の取りまとめです。

各会社から【研修会受講者名簿】というものが、エクセルファイルで送られてきますので、これを集計します。

f:id:hiroakies4463:20200220225212j:plain

f:id:hiroakies4463:20200220225219j:plain

f:id:hiroakies4463:20200220225232j:plain

ちなみに研修会は日程ごとに1班~4班あり、シート名に入れてもらっています。

研修会を開いてる側ですが、実際、10社20社となると集計作業がだいぶ面倒です(笑)

それだけではなく、時期が近づくと辞退者が出たり新たに参加したいという人が増えたりします。このように、いわゆる変更連絡というものがあれば、その都度名簿を作り直さなければいけません。

これ非常に面倒くさいんで(笑)、私の場合は、これらのファイルを開かずに一気に集計したいと思います。

 

方法

まず、下のように出席報告フォルダを用意します。

f:id:hiroakies4463:20200220225147j:plain

つぎに、そのフォルダ内に各会社より送られてきた受講者名簿のファイルを保存。集計ファイルを用意します。

f:id:hiroakies4463:20200220225202j:plain

集計ファイルには作業シートと出力シートを用意します。

画像の通りに作ります~説明は省きます~笑

f:id:hiroakies4463:20200307164241j:plain

出力シートはまっさらな状態です。※この線は気にしないでください。

f:id:hiroakies4463:20200220225246j:plain

作業シートの青いボタン(VBAが設定されています)を押すと、下のように出力シートに集計結果が出てきます。

f:id:hiroakies4463:20200307164104j:plain
以上です。

コピペの作業から解放されるので、少し楽ですね。

コード例

 改良の余地ありですが、こんな感じで書きました。

  1. Sub 開く()
  2. Dim name As Range
  3. Dim name_worksheet As String
  4. Dim hanni As String
  5. Dim fn As String
  6. Dim wb As Workbook
  7. Dim n As Integer
  8. Worksheets("出力").Cells.Clear
  9. Worksheets("出力").Range("A1") = "ファイル名"
  10. Worksheets("出力").Range("B1") = "貼付け内容"
  11. Worksheets("作業").Activate
  12. name_worksheet = Worksheets("作業").Range("C1")
  13. hanni = Worksheets("作業").Range("D1")
  14. For Each name In Worksheets("作業").Range("A2").CurrentRegion
  15. fn = ThisWorkbook.Path & "¥" & name.Value & ".xlsx"
  16. On Error Resume Next
  17. Application.DisplayAlerts = False
  18. Set wb = Workbooks.Open(fn)
  19. If WorksheetFunction.CountBlank(Worksheets(name_worksheet).Range(hanni)) = Worksheets(name_worksheet).Range(hanni).Count Then
  20. Workbooks("集計ファイル.xlsm").Worksheets("出力").Range("B" & Rows.Count).End(xlUp).Offset(1, 0) = "空白です"
  21. Workbooks("集計ファイル.xlsm").Worksheets("作業").Activate
  22. Worksheets("出力").Range("B" & Rows.Count).End(xlUp).Offset(0, -1) = name.Value
  23. wb.Close
  24. Else
  25. Worksheets(name_worksheet).Range(hanni).Copy
  26. Workbooks("集計ファイル.xlsm").Worksheets("出力").Range("B" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial
  27. Workbooks("集計ファイル.xlsm").Worksheets("出力").Range("B" & Rows.Count).End(xlUp).Offset(0, -1) = name.Value
  28. n = -1
  29. Do Until n = 1
  30. If Workbooks("集計ファイル.xlsm").Worksheets("出力").Range("B" & Rows.Count).End(xlUp).Offset(n, -1) = "" Then
  31. Workbooks("集計ファイル.xlsm").Worksheets("出力").Range("B" & Rows.Count).End(xlUp).Offset(n, -1) = name.Value
  32. n = n - 1
  33. Else
  34. n = 1
  35. End If
  36. Loop
  37. wb.Close
  38. End If
  39. Next
  40. End Sub

標準モジュールへコピペして使ってみてください。

詳しい使い方や注意点はVBAの基礎的なことを踏まえて、次回以降また説明したいと思います。

質問等はお気軽にツイッターへどうぞ。

 

ではでは。

 

hiroakies.hatenablog.com