(Excel)毎月入力し直す金額シートから、年間（月別）累計シートを作成したい

質問

WinXPでExcel2002を使っています。
今回の内容ですが、
以下のような月次給与計算シートがあります。
　毎月15日に入力されるので、内容が月で変わります。
　セルA1　処理月　セルB2　職員名　セルC2　給与額
　　　　　　　　　　　 　・・・　　　　　 ・・・

上記月次計算が終了した時点で、
以下のような職員別月別給与累計表に自動転記し、作成するにはどうすればよいでしょうか？

　　　　　1月　2月　・・・　12月　計
職員名

・・・　

よろしくお願いします。

回答No.1

ham_kamo · ベストアンサー

シートが月別でなく、一つのシートに各月分が連続して書かれているのなら、ピボットテーブルを使えば一発なのですが…。

Excel勉強中の身で、自分の仕事にも使い回せそうなので、課題と思ってマクロを組んでみました。「月次計算のタイミングで転記」とのことで、そのタイミングで実行するマクロです。ただし、正常に動作するためには以下の点に注意が必要です。

・月次給与計算シートと職員別給与累計表のシートは同一ブックにあり、それぞれ1番目、２番目のシートとなっている。
・「職員別給与累計表」には月名と職員名は予め正しく記入されている。
・「職員別給与累計表」にはB1～M1に「○月」と入力されており、A2より下に職員名一覧が空白なく最後まで入力されている
・合計列には1月～12月の合計を求める数式はあらかじめ入っている。

と仮定しています。

エラーハンドリングとしては、

・月次給与計算シートのA1に正しい月数が入ってなかったらエラー
・月次給与計算シートと職員別給与累計表の職員名の並び順は違ってもかまわないが、職員別給与累計表に転記しようとした名前がない場合は警告を出し、処理を続行するか中断するか選択できる。

となっています。

Alt+F11でVBEを起動し、ThisWorkBookにでも以下のコードを貼り付けて実行してみてください。うまく動かないときや、違うブックに転記したいときは補足願います。

Sub 職員別給与累計表更新()
Const GETSUJI = 1
Const RUIKEI = 2
Dim This_Month As String '月次給与計算シートのA1に記入さ れている月数
Dim Ruikei_Column As Integer '職員別給与累計表シートの当月の列ナンバー
Dim Ruikei_Shokuin As Range '職員別給与累計表シートに転記中の職員の名前が入ったセル
Dim Ruikei_Shokuin_Row As Integer '上記セルの行番号
Dim Shokuin_Row As Integer '転記中の職員の月次給与計算シート上の行番号
Dim Shokuin_Name As String '転記中の職員名
Dim Shokuin_Salary As Long '転記中の職員の当月給与額
Dim IsContinue As Integer
'転記する職員名が職員別給与累計表になかった場合に
'処理を続行するかどうかのフラグ

This_Month = Worksheets(GETSUJI).Range("A1").Value
If Val(This_Month) < 1 Or Val(This_Month) > 12 Then
MsgBox "月の指定に誤りがあります", vbCritical, "エラー"
With Worksheets(GETSUJI)
.Activate
.Range("A1").Select
End With
Exit Sub
End If
Ruikei_Column = Val(This_Month) + 1

Shokuin_Row = 2
Shokuin_Name = Worksheets(GETSUJI).Cells(Shokuin_Row, 2)
Do While (Shokuin_Name <> "")
Set Ruikei_Shokuin = Worksheets(RUIKEI).Range("A:A").Find(Shokuin_Name, , xlWhole)
If Ruikei_Shokuin Is Nothing Then
Worksheets(RUIKEI).Activate
IsContinue = MsgBox("社員「" & Shokuin_Name & "」が登録されてません " & vbCr & _
"続行しますか？", vbYesNo + vbExclamation, "社員未登録")
If IsContinue = vbNo Then
Exit Sub
End If
Else
Ruikei_Shokuin_Row = Ruikei_Shokuin.Row
Shokuin_Salary = Worksheets(GETSUJI).Cells(Shokuin_Row, 3).Value
Worksheets(RUIKEI).Cells(Ruikei_Shokuin_Row, Ruikei_Column) = Shokuin_Salary
End If
Shokuin_Row = Shokuin_Row + 1
Shokuin_Name = Worksheets(GETSUJI).Cells(Shokuin_Row, 2)
Loop
Worksheets(RUIKEI).Activate
End Sub

お礼

ham_kamo さん。どうもありがとうございました。
VBA？ですね。
早速、確認してみます。