初めに
今回の記事はVBA勉強会にて、お題に沿って自分なりにVBAを書いたものになります。
私自身VBA歴はまだまだ浅く、勉強中の身ですのでベストプラクティスとは言えないコードになっていることと思います。そのためあまり参考にならない可能性がありますのでご了承ください。
お題の内容
- 課題は「売上実績」と「社員マスタ」の2つのデータから「年間実績」ファイルへ必要情報を集計、転記する内容です。
- 売上実績は2020年度の1年間の売上データとしています(2020/4月〜2021/3月)。
- 売上実績の売上金額を社員番号毎に月単位に合計して年間実績の月列に値を入力して下さい。
- 社員氏名、性別、所属支店名は社員マスタのデータにありますので、これはそのまま転記する形として下さい。
- マクロのトリガーは自由です。マクロの実行からでも良いですし、ボタンを配置しても構いません。
- 完成形に間違いがなければ、どのような組み方でも構いません。
- 一点だけ制約としてはOSはWindowsに統一します。
- また、全ての社員に売上データがあるとは限りません。
ファイルの内容
社員マスタ.xlsx
売上実績.xlsx
年間実績.xlsm(集計先)
コードと実行結果
Option Explicit
'フォルダパスと作業シート用変数
Dim FilePath As String
Dim 集計先シート As Worksheet
Sub 集計()
'フォルダパスを取得、集計先のシートを変数に格納
FilePath = ThisWorkbook.Path
Set 集計先シート = ThisWorkbook.Sheets("Sheet1")
'確認ダイアログ&画面更新オフ
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'処理時間記録用変数
Dim startTime As Double
Dim endTime As Double
Dim processTime As Double
'タイマー開始
startTime = Timer
'処理の呼び出し
Call 社員情報転記
Call 売上転記
'タイマー終了、差し引きを取得
endTime = Timer
processTime = endTime - startTime
Application.ScreenUpdating = True
Application.DisplayAlerts = True
'完了メッセージと、処理時間を出力
MsgBox "完了しました。" & vbCrLf & "処理時間:" & Round(processTime, 2) & "秒"
End Sub
Sub 社員情報転記()
'社員マスタシートを開き、変数に格納
Workbooks.Open FilePath & "\" & "社員マスタ.xlsx", ReadOnly:=True
Dim 社員マスタブック As Workbook: Set 社員マスタブック = ActiveWorkbook
Dim 社員マスタシート As Worksheet: Set 社員マスタシート = 社員マスタブック.Sheets("社員マスタ")
'最終行取得
Dim LastRow As Long
LastRow = 社員マスタシート.Range("A1").End(xlDown).Row
'カウント変数
Dim i As Long
With 集計先シート
'順番をいれかえて転記
For i = 2 To LastRow
.Cells(i, 2) = 社員マスタシート.Cells(i, 2)
.Cells(i, 3) = 社員マスタシート.Cells(i, 4)
.Cells(i, 4) = 社員マスタシート.Cells(i, 3)
Next
End With
社員マスタブック.Close
End Sub
Sub 売上転記()
'売上実績を開き変数に格納
Workbooks.Open FilePath & "\" & "売上実績.xlsx", ReadOnly:=True
Dim 売上実績ブック As Workbook: Set 売上実績ブック = ActiveWorkbook
Dim 実績管理表シート As Worksheet: Set 実績管理表シート = 売上実績ブック.Sheets("実績管理表")
'最終行取得
Dim LastRow1 As Long: LastRow1 = 集計先シート.Range("A1").End(xlDown).Row
Dim LastRow2 As Long: LastRow2 = 実績管理表シート.Range("A1").End(xlDown).Row - 1 '最終集計行を除く
'カウント変数
Dim i As Long
Dim j As Long
Dim k As Long
'繰り返し処理に使用
Dim Key As String '検索キー(社員番号)
Dim WKMonth As Long: WKMonth = 4 '作業月を格納
Dim Total As Long: Total = 0 '条件に合った時に加算する用
'年間集計の列ごとの繰り返し処理(12ヵ月分)
For i = 5 To 16
'年間集計の行ごとの繰り返し処理(社員数分)
For j = 2 To LastRow1
Key = 集計先シート.Cells(j, 1)
'売上実績の実績管理表シートの繰り返し処理(売上項目数)
For k = 2 To LastRow2
'もし、実績管理表シートの月が指定の月で、かつ、Keyが一致したら
With 実績管理表シート
If Month(.Cells(k, 1)) = WKMonth And Key = .Cells(k, 2) Then
'金額を加算
Total = Total + .Cells(k, 3)
End If
End With
Next
'実績管理表シートのすべての項目をチェックし終わったら転記する
集計先シート.Cells(j, i) = Total
'リセット
Total = 0
Next
'もし作業月を示すが12なら1に戻す
If WKMonth = 12 Then
WKMonth = 1
'それ以外なら1加算
Else
WKMonth = WKMonth + 1
End If
Next
売上実績ブック.Close
End Sub
### 実装のポイント
- 社員マスタと年間実績の社員情報の順番が違うこと
- 月ごとに合計をするが、スタートが4月になっていること
- 月と社員IDの条件があう場合をどうやって処理するか
ポイントの解説
1.社員マスタと年間実績の社員情報の順番が違う
With 集計先シート
'順番をいれかえて転記
For i = 2 To LastRow
.Cells(i, 2) = 社員マスタシート.Cells(i, 2)
.Cells(i, 3) = 社員マスタシート.Cells(i, 4)
.Cells(i, 4) = 社員マスタシート.Cells(i, 3)
Next
End With
行が違うものに関してはそのまま転記できないため、行をそれぞれ指定して実装。
2 . 月ごとに合計をするが、スタートが4月になっていること
3 . 月と社員IDの条件があう場合をどうやって処理するか
Dim WKMonth As Long: WKMonth = 4 '作業月を格納
With 実績管理表シート
If Month(.Cells(k, 1)) = WKMonth And Key = .Cells(k, 2) Then
'金額を加算
Total = Total + .Cells(k, 3)
End If
End With
'もし作業月を示すが12なら1に戻す
If WKMonth = 12 Then
WKMonth = 1
'それ以外なら1加算
Else
WKMonth = WKMonth + 1
End If
作業列を示すWKMonthを4で初期化し、繰り返し処理で1づつプラスして評価するようにした。また、月と社員IDが紐づくかの確認はIF文でANDを使用し、複数条件に合う場合に合計を算出するようにした。
感想
まだ配列に慣れていなく、うまく落とし込めていないので現状のスキルで実装しやすいコードで記述しました。課題として感じたのはやはりForNextは処理に時間がかかること。データの総数は見切れていてお伝えできていなかったと思いますが、社員IDは52人、処理項目は225件、1年分(12か月)を掛け算すると140,400通りの繰り返し処理をしていることになります。実装後、時間がかかるなと思ったのでタイマーも入れましたが、項目を増やすとみるみる遅くなったのであまり実用的ではないのかなと反省しています。
勉強会では、連想配列を使用したり、シンプルにSUMIFSを埋め込んだりしている方がおり、とても参考になりました。今後はもっと効率の良いコードをかけるように勉強していきたいと思います。