複数のエクセルを１つのエクセルに集計する方法
様々な人や、様々な組織から同じフォーマットのエクセルを提出してもらって、それを手で集計するのは、大変ですよね。特に公務員獣医師の方は、こういった作業は多いのではないでしょうか。また、大きな獣医師の組織を作っている方もこういった作業があるかと思います。
都道府県の支部から提出してもらったエクセルを集計するという想定で、VBAマクロを使って対処します。
前提
１つのフォルダに、集計をまとめるためのエクセルと、提出してもらったエクセルが入っています。エクセルの拡張子はxlsxでそろえて下さい。また、提出してもらったエクセルの名前は、組織の名前としてください。ここでは、都道府県支部から提出されたと想定して、以下のように名前をつけます。北海道、青森県、岩手県、宮城県、秋田県、山形県、福島県、茨城県、栃木県、群馬県、埼玉県、千葉県、東京都、神奈川県、新潟県、富山県、石川県、福井県、山梨県、長野県、岐阜県、静岡県、愛知県、三重県、滋賀県、京都府、大阪府、兵庫県、奈良県、和歌山県、鳥取県、島根県、岡山県、広島県、山口県、徳島県、香川県、愛媛県、高知県、福岡県、佐賀県、長崎県、熊本県、大分県、宮崎県、鹿児島県、沖縄県。
提出エクセル
提出してもらうエクセルは、ファイル名を組織名にします。そして、回答という名前のシートがあります。そこに、１列目に名前、２列目に回答内容が入っています。
集計エクセル
集計をまとめるためのエクセルには、回答集計という名前のシートがあります。そこに、１列目に提出してもらった組織の名前、２列目に名前、３列目に回答内容を記載するようにしたいです。もちろん自動でやりたい。
集計エクセルのVBAマクロ
集計をまとめるためのエクセルのほうを開き、visual basicエディターを開いて、以下のコードを貼り付けてください。そしてマクロを実行してください。シート名や組織名が異なる場合には、修正してください。修正しないとエラーがでます。
Sub 出席者()
Dim a, b, c, d, e, f, g, i, j As Long
Dim todofuken
Dim miteisyutu(46) As String 'ここの数字は、回答数ー１としてください。
Dim dashitenaiken As String
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
Dim syukei As Workbook
Dim targetbook As Workbook
Set syukei = ThisWorkbook
For i = 1 To 47 '47は回答数を入れて下さい。
syukei.Worksheets("回答集計").Activate
'以下は、回答者を入れて下さい。
If i = 1 Then
todofuken = "北海道"
ElseIf i = 2 Then
todofuken = "青森県"
ElseIf i = 3 Then
todofuken = "岩手県"
ElseIf i = 4 Then
todofuken = "宮城県"
ElseIf i = 5 Then
todofuken = "秋田県"
ElseIf i = 6 Then
todofuken = "山形県"
ElseIf i = 7 Then
todofuken = "福島県"
ElseIf i = 8 Then
todofuken = "茨城県"
ElseIf i = 9 Then
todofuken = "栃木県"
ElseIf i = 10 Then
todofuken = "群馬県"
ElseIf i = 11 Then
todofuken = "埼玉県"
ElseIf i = 12 Then
todofuken = "千葉県"
ElseIf i = 13 Then
todofuken = "東京都"
ElseIf i = 14 Then
todofuken = "神奈川県"
ElseIf i = 15 Then
todofuken = "新潟県"
ElseIf i = 16 Then
todofuken = "富山県"
ElseIf i = 17 Then
todofuken = "石川県"
ElseIf i = 18 Then
todofuken = "福井県"
ElseIf i = 19 Then
todofuken = "山梨県"
ElseIf i = 20 Then
todofuken = "長野県"
ElseIf i = 21 Then
todofuken = "岐阜県"
ElseIf i = 22 Then
todofuken = "静岡県"
ElseIf i = 23 Then
todofuken = "愛知県"
ElseIf i = 24 Then
todofuken = "三重県"
ElseIf i = 25 Then
todofuken = "滋賀県"
ElseIf i = 26 Then
todofuken = "京都府"
ElseIf i = 27 Then
todofuken = "大阪府"
ElseIf i = 28 Then
todofuken = "兵庫県"
ElseIf i = 29 Then
todofuken = "奈良県"
ElseIf i = 30 Then
todofuken = "和歌山県"
ElseIf i = 31 Then
todofuken = "鳥取県"
ElseIf i = 32 Then
todofuken = "島根県"
ElseIf i = 33 Then
todofuken = "岡山県"
ElseIf i = 34 Then
todofuken = "広島県"
ElseIf i = 35 Then
todofuken = "山口県"
ElseIf i = 36 Then
todofuken = "徳島県"
ElseIf i = 37 Then
todofuken = "香川県"
ElseIf i = 38 Then
todofuken = "愛媛県"
ElseIf i = 39 Then
todofuken = "高知県"
ElseIf i = 40 Then
todofuken = "福岡県"
ElseIf i = 41 Then
todofuken = "佐賀県"
ElseIf i = 42 Then
todofuken = "長崎県"
ElseIf i = 43 Then
todofuken = "熊本県"
ElseIf i = 44 Then
todofuken = "大分県"
ElseIf i = 45 Then
todofuken = "宮崎県"
ElseIf i = 46 Then
todofuken = "鹿児島県"
ElseIf i = 47 Then
todofuken = "沖縄県"
End If
Dim 現在のパス, 目的ファイルのパス As String
現在のパス = Replace(ThisWorkbook.Path, "\", "/")
目的ファイルのパス = 現在のパス & "/" & todofuken & ".xlsx"
If Dir(目的ファイルのパス) <> "" Then
miteisyutu(i - 1) = ""
Set targetbook = Workbooks.Open(目的ファイルのパス)
With targetbook.Worksheets("回答")
a = .Range("B5000").End(xlUp).Row
.Activate
.Range(Cells(2, 1), Cells(a, 2)).Copy '回答の形に合わせて調整してください
ThisWorkbook.Worksheets("回答集計").Activate
c = ThisWorkbook.Worksheets("回答集計").Range("B5000").End(xlUp).Row + 1
ThisWorkbook.Worksheets("回答集計").Cells(c, 2).Select
ActiveSheet.Paste
ThisWorkbook.Worksheets("回答集計").Cells(c, 1).Value = todofuken
End With
Application.DisplayAlerts = False
targetbook.Close
Application.DisplayAlerts = True
Else
miteisyutu(i - 1) = todofuken
End If
Next i
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
For j = 0 To UBound(miteisyutu)
If miteisyutu(j) <> "" Then
dashitenaiken = dashitenaiken & "," & miteisyutu(j)
End If
Next
MsgBox "未提出の県" & dashitenaiken
End Sub