人毎の勤務表を別ブックにてサマリ集計する方法について

Question

勤務表入力用ファイルが人数分、その集計用ファイルが1ファイルの構成になっています。
(10人の場合は11ファイル、30人の場合は31ファイル)

勤務表入力用ファイルは1つのブック内に1月～12月の12シートが入っています。
各シートに31日分の開始時間と終了時間を入力し、1日の作業時間と31日分の合計作業時間が自動計算されるようになっています。

集計用ファイルの表則は、
縦軸の項目が勤務者の名前が列挙され、横軸の項目はが1月、2月・・・12月、合計となっており、
全員の1年間の合計値が集計されます。


困っているのは、上記ファイル群を1セットとし、各グループに配布するので、
名前や人数は固定されていません。
ただMAX値としては30と想定されているため、
今の私が思いつくのは、
勤務表入力用ファイルは、ファイル名を01.xlsx、02.xlsx、・・・30.xlsx と用意しておき、
集計用ファイルの方には、縦01～30までの各ファイルの各月の合計作業時間を参照するように設定しておく方法です。

ですが、
・勤務表のファイル名を勝手に変更されたら参照できなくなる？
・集計用ファイルの縦軸には氏名を自動的に入れたい。
・万が一30名以上だった場合でも対応できた方が良い
等の課題が考えられるのですが、それらをクリアして汎用性を持たせたいです。

上記の解決法、またはもっとスマートなやり方等、
手法も含めてお知恵をお貸しください。

説明不足の点もあるかもしれません。ご指摘いただければ補足させていただきます。

mike32 · Accepted Answer

遅くなりましてすみません。
勤務表の１月～１２月のシート名が何になっているか、また、シート名が変更されている場合でも集計できるように
シート名ではなく、勤務表のセルの内容で判定するようにしました。

勤務表ですので、すべて共通のフォーマットであることだと思いますので、ある程度推測でセル番地を入れてみました。

最初のほうのConstで始まっている行のセル番地を実際のものに変えていただければ、使用できます。

・勤務表の氏名が入力されているセル
・勤務表の合計作業時間が表示されているセル
・勤務表内に月が表示されているセル（数字だけが入っていると仮定しています）
　　もし、「１月」というように入力されているのであれば、マクロ内のSYUUKEISTの部分で数値だけ取り出した値を
　　使用するように修正をお願いします。

・集計表は３行目から反映するようにしていまして、
１列目が氏名、２列目以降が１月から１２月の合計作業時間としています。
２列目に項目名や、１列目にタイトルなどを入れていただけるように、3行目からにしています。

（実行テスト確認済みです）

Option Explicit

Const SHIMEICELL = "B2"     '勤務表の氏名のセル
Const GOUKEICELL = "B32"    '勤務表の合計作業時間のセル
Const TSUKICELL = "C2"      '勤務表の月のセル
Const SYUUKEIST = 3         '集計表の書き出し開始行
    
'集計ボタン
Sub ボタン1_Click()
    Call sample1
End Sub

'集計処理
Sub sample1()
    Dim sDir As String
    Dim sFileName As String
    Dim sFullName As String
    Dim kinmuName As String
    Dim kinmuSum As Long
    Dim summaryRow As Long
    Dim summaryWk As Workbook
    Dim kinmuWk As Workbook

Set summaryWk = ThisWorkbook
    
    'フォルダの選択
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = True Then
            sDir = .SelectedItems(1)
        Else
            Exit Sub
        End If
    End With
    
    '選択されたフォルダ内の最初のファイルを取得
    sFileName = Dir(sDir & "\" & "*.xls?")
    '選択されたフォルダ内にエクセルファイルがない場合
    If sFileName = "" Then
        MsgBox "勤務表がありません。", vbExclamation, "エラー"
        Exit Sub
    End If
    
    '画面描画を停止
    Application.ScreenUpdating = False
    
    sFullName = sDir & "\" & sFileName
    
    '勤務表を開き、集計表に値を転記
    Do
        sFullName = sDir & "\" & sFileName
        
        '最初のファイルを開く
        Set kinmuWk = Workbooks.Open(Filename:=sFullName, ReadOnly:=True)
        '勤務表の最初のシートのA2に入っている氏名を取得
        kinmuName = kinmuWk.Worksheets(1).Range(SHIMEICELL)
        '集計表の何行目にその人のデータがあるか確認
        summaryRow = fnGetRow(summaryWk, kinmuName)
        '集計表に勤務表の合計作業時間を反映
        Call sbSetSummary(kinmuWk, summaryWk, summaryRow)
        'ファイルを閉じる
        kinmuWk.Close
        
        '同一フォルダ内の次のファイル名を取得
        sFileName = Dir()
        
    Loop Until sFileName = ""   'ファイルがすべて処理済みになったらループ終了
    
    '画面描画を開始
    Application.ScreenUpdating = True
    
    MsgBox "集計終了"
    
End Sub

'集計表内の氏名を検索し、該当行を求める。
Function fnGetRow(summaryWk As Workbook, sName As String) As Long
    Dim i As Long
    
    With summaryWk.Worksheets(1)
        '集計表の検索開始行
        i = SYUUKEIST
        Do Until .Cells(i, "A") = sName Or .Cells(i, "A") = ""
            i = i + 1
        Loop
        '集計表に氏名が存在しない場合
        If .Cells(i, "A") = "" Then
            '最終行の下に氏名をセットし、その行を返す
            .Cells(i, "A") = sName
        End If
    End With
    
    '検索結果の行を返す
    fnGetRow = i
End Function

'勤務シートから集計シートへ値を転記
Sub sbSetSummary(kinmuWk As Workbook, summaryWk As Workbook, summaryRow As Long)
    Dim i As Long
    Dim sKinmuName As String
    
    For i = 1 To 12
        '該当月の勤務表のワークシートを取得
        sKinmuName = fnGetSheet(kinmuWk, i)
        
        'シート存在時
        If sKinmuName <> "" Then
            '勤務表に反映
            summaryWk.Worksheets(1).Cells(summaryRow, i + 1) = kinmuWk.Worksheets(sKinmuName).Range(GOUKEICELL)
        End If
    Next
    
End Sub

'勤務表内のシートから指定月のワークシートを取得
Function fnGetSheet(kinmuWk As Workbook, tsuki As Long) As String
    Dim i As Long
    Dim tmpSheetName As String
    tmpSheetName = ""

With kinmuWk
        For i = 1 To .Worksheets.Count
            If .Worksheets(i).Range(TSUKICELL) = tsuki Then
                tmpSheetName = .Worksheets(i).Name
                Exit For
            End If
        Next
    End With
    
    fnGetSheet = tmpSheetName
End Function

mike32 · Answer

No.3のマクロの集計表の画面イメージです。

mike32 · Answer

INDIRECT関数を使わなくても、該当フォルダ内のエクセルファイルをひとつずつ開いて
氏名の入っているや集計値セルをコピーしていけばいいのではないでしょうか。

集計用ファイルは別フォルダにあるとした場合、フォルダ内のファイル名をDIR関数で取得して
ひとつずつ処理していけばいいと思います。

mike32 · Answer

VBAで行うこととなってしまいますが、下記の方法はいかがでしょうか。
《前提》
・勤務表入力用ファイルのあるセルに氏名を入れておく。
・勤務表入力用ファイルは１か所のフォルダ（以下、集計用フォルダ）にまとめておき、ファイル名は変更されてもいい状態とする。

《集計処理》
・集計用フォルダ内のブックを読み、氏名と合計作業時間を取得し、集計用ファイルに転記する。
　（集計用ファイルに該当氏名があれば、その人の合計作業時間の欄に転記。氏名がなければ行追加して転記）

※氏名をキーとすると、同姓同名が出てくるかもしれないので、社員番号をもとに集計したほうがいいのではないかと思います。

人毎の勤務表を別ブックにてサマリ集計する方法について

遅くなりましてすみません。

No.3のマクロの集計表の画面イメージです。

INDIRECT関数を使わなくても、該当フォルダ内のエクセルファイルをひとつずつ開いて

VBAで行うこととなってしまいますが、下記の方法はいかがでしょうか。

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング