Option Explicit
Const folder As String = "d:\goo\data2"     '元データの格納フォルダ
Public Sub 割増時間設定()
    Dim ssh As Worksheet    '祝日シート
    Dim msh As Worksheet    '集計シート複数
    Dim tsh As Worksheet    '元データシート
    Dim wrow As Long        '行　作業用
    Dim wrow2 As Long       '行　作業用
    Dim wcol2 As Long       '列　作業用
    Dim maxrow1 As Long     '祝日の最大行
    Dim maxrow2 As Long     '元データの最大行
    Dim dicT As Object      '祝日の記憶用
    Dim dicM As Object      '社員コードの記憶用
    Dim sheet_no As Long    'シート番号
    Dim book_path As String '元データのパス名
    Dim twb As Workbook     '元データのブック
    Dim wdate As Variant    '日付
    Dim bango As Variant    '社員番号
    Dim wtime As Variant    '割増時間
    Dim week_day As Long    '1週間の番号1:日、7：土
    Dim wday As Long        '年月日の日
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
 
    Set dicT = CreateObject("Scripting.Dictionary") ' 連想配列の定義
    Set dicM = CreateObject("Scripting.Dictionary") ' 連想配列の定義
    '祝日の記憶
    Set ssh = Worksheets("祝日")
    maxrow1 = ssh.Cells(Rows.Count, "A").End(xlUp).Row '祝日 A列　最終行を求める
    For wrow = 2 To maxrow1
        dicT(ssh.Cells(wrow, "A").Value) = True
    Next
    '全集計シートの社員コードとシートを記憶する
    For sheet_no = 1 To Worksheets.Count
        Call GetSheetInfo(sheet_no, dicM)
    Next
    '元データを読み込み割増時間を設定する
    book_path = folder & "\" & "元データ.xlsx"
    Set twb = Workbooks.Open(book_path)
    Set tsh = twb.Worksheets("元データ")
    maxrow2 = tsh.Cells(Rows.Count, "A").End(xlUp).Row '元データ A列　最終行を求める
    For wrow = 2 To maxrow2
        wdate = tsh.Cells(wrow, "A").Value  '日付
        bango = tsh.Cells(wrow, "B").Value  '社員番号
        week_day = weekday(wdate)
        wday = Day(wdate)
        '祭日又は日曜又は土曜ならY列採用、左記以外はX列採用
        If dicT.exists(wdate) = True Or week_day = 1 Or week_day = 7 Then
            wtime = tsh.Cells(wrow, "Y").Value
        Else
            wtime = tsh.Cells(wrow, "X").Value
        End If
        '但し、シフト勤務のみ、X列を無条件に採用する
        If dicM.exists(bango) = True Then
            If dicM(bango)(2) = True Then       'シフト勤務の場合
                wtime = tsh.Cells(wrow, "X").Value
            End If
        End If
        If dicM.exists(bango) = True Then
            sheet_no = dicM(bango)(0)   '社員番号対応の集計シートのシート番号
            wrow2 = dicM(bango)(1)      '社員番号対応の集計シートの行番号
            wcol2 = 7 + wday            '割増時間設定の列
            ThisWorkbook.Worksheets(sheet_no).Cells(wrow2, wcol2).Value = wtime
        End If
    Next
    twb.Close
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    MsgBox ("完了")
End Sub
'シート情報の記憶（シート番号と社員番号）
Private Sub GetSheetInfo(ByVal sheet_no As Long, ByVal dicM As Object)
    Dim ws As Worksheet
    Dim wno As Long
    Dim wrow As Long        '社員番号の行番号
    Dim wrow2 As Long       '時間の行番号
    Dim bango As Variant
    Dim flag As Boolean
    flag = False
    Set ws = Worksheets(sheet_no)
    '処理対象外のシートはスキップする
    If ws.Name = "祝日" Or ws.Name = "フォーマット" Or ws.Name = "時間外" Then Exit Sub
    If ws.Range("A1").Value = "シフト勤務" Then
        flag = True
    End If
    '10人分繰り返す
    For wno = 1 To 10
        wrow = (wno - 1) * 6 + 5
        wrow2 = wrow + 2
        bango = ws.Cells(wrow, "A").Value
        '社員番号が登録されていれば、シート番号と行番号を記憶する
        If bango <> "" Then
            dicM(bango) = Array(sheet_no, wrow2, flag)              'シート番号と行番号とシフト勤務を記憶
        End If
        ws.Range("H" & wrow2 & ":AL" & wrow2).Value = ""            '時間クリア
    Next
End Sub
 

T3B0aW9uIEV4cGxpY2l0CkNvbnN0IGZvbGRlciBBcyBTdHJpbmcgPSAiZDpcZ29vXGRhdGEyIiAgICAgJ+WFg+ODh+ODvOOCv+OBruagvOe0jeODleOCqeODq+ODgApQdWJsaWMgU3ViIOWJsuWil+aZgumWk+ioreWumigpCiAgICBEaW0gc3NoIEFzIFdvcmtzaGVldCAgICAn56Wd5pel44K344O844OICiAgICBEaW0gbXNoIEFzIFdvcmtzaGVldCAgICAn6ZuG6KiI44K344O844OI6KSH5pWwCiAgICBEaW0gdHNoIEFzIFdvcmtzaGVldCAgICAn5YWD44OH44O844K/44K344O844OICiAgICBEaW0gd3JvdyBBcyBMb25nICAgICAgICAn6KGM44CA5L2c5qWt55SoCiAgICBEaW0gd3JvdzIgQXMgTG9uZyAgICAgICAn6KGM44CA5L2c5qWt55SoCiAgICBEaW0gd2NvbDIgQXMgTG9uZyAgICAgICAn5YiX44CA5L2c5qWt55SoCiAgICBEaW0gbWF4cm93MSBBcyBMb25nICAgICAn56Wd5pel44Gu5pyA5aSn6KGMCiAgICBEaW0gbWF4cm93MiBBcyBMb25nICAgICAn5YWD44OH44O844K/44Gu5pyA5aSn6KGMCiAgICBEaW0gZGljVCBBcyBPYmplY3QgICAgICAn56Wd5pel44Gu6KiY5oa255SoCiAgICBEaW0gZGljTSBBcyBPYmplY3QgICAgICAn56S+5ZOh44Kz44O844OJ44Gu6KiY5oa255SoCiAgICBEaW0gc2hlZXRfbm8gQXMgTG9uZyAgICAn44K344O844OI55Wq5Y+3CiAgICBEaW0gYm9va19wYXRoIEFzIFN0cmluZyAn5YWD44OH44O844K/44Gu44OR44K55ZCNCiAgICBEaW0gdHdiIEFzIFdvcmtib29rICAgICAn5YWD44OH44O844K/44Gu44OW44OD44KvCiAgICBEaW0gd2RhdGUgQXMgVmFyaWFudCAgICAn5pel5LuYCiAgICBEaW0gYmFuZ28gQXMgVmFyaWFudCAgICAn56S+5ZOh55Wq5Y+3CiAgICBEaW0gd3RpbWUgQXMgVmFyaWFudCAgICAn5Ymy5aKX5pmC6ZaTCiAgICBEaW0gd2Vla19kYXkgQXMgTG9uZyAgICAnMemAsemWk+OBrueVquWPtzE65pel44CBN++8muWcnwogICAgRGltIHdkYXkgQXMgTG9uZyAgICAgICAgJ+W5tOaciOaXpeOBruaXpQogICAgQXBwbGljYXRpb24uU2NyZWVuVXBkYXRpbmcgPSBGYWxzZQogICAgQXBwbGljYXRpb24uQ2FsY3VsYXRpb24gPSB4bENhbGN1bGF0aW9uTWFudWFsCiAgICAKICAgIFNldCBkaWNUID0gQ3JlYXRlT2JqZWN0KCJTY3JpcHRpbmcuRGljdGlvbmFyeSIpICcg6YCj5oOz6YWN5YiX44Gu5a6a576pCiAgICBTZXQgZGljTSA9IENyZWF0ZU9iamVjdCgiU2NyaXB0aW5nLkRpY3Rpb25hcnkiKSAnIOmAo+aDs+mFjeWIl+OBruWumue+qQogICAgJ+elneaXpeOBruiomOaGtgogICAgU2V0IHNzaCA9IFdvcmtzaGVldHMoIuelneaXpSIpCiAgICBtYXhyb3cxID0gc3NoLkNlbGxzKFJvd3MuQ291bnQsICJBIikuRW5kKHhsVXApLlJvdyAn56Wd5pelIEHliJfjgIDmnIDntYLooYzjgpLmsYLjgoHjgosKICAgIEZvciB3cm93ID0gMiBUbyBtYXhyb3cxCiAgICAgICAgZGljVChzc2guQ2VsbHMod3JvdywgIkEiKS5WYWx1ZSkgPSBUcnVlCiAgICBOZXh0CiAgICAn5YWo6ZuG6KiI44K344O844OI44Gu56S+5ZOh44Kz44O844OJ44Go44K344O844OI44KS6KiY5oa244GZ44KLCiAgICBGb3Igc2hlZXRfbm8gPSAxIFRvIFdvcmtzaGVldHMuQ291bnQKICAgICAgICBDYWxsIEdldFNoZWV0SW5mbyhzaGVldF9ubywgZGljTSkKICAgIE5leHQKICAgICflhYPjg4fjg7zjgr/jgpLoqq3jgb/ovrzjgb/libLlopfmmYLplpPjgpLoqK3lrprjgZnjgosKICAgIGJvb2tfcGF0aCA9IGZvbGRlciAmICJcIiAmICLlhYPjg4fjg7zjgr8ueGxzeCIKICAgIFNldCB0d2IgPSBXb3JrYm9va3MuT3Blbihib29rX3BhdGgpCiAgICBTZXQgdHNoID0gdHdiLldvcmtzaGVldHMoIuWFg+ODh+ODvOOCvyIpCiAgICBtYXhyb3cyID0gdHNoLkNlbGxzKFJvd3MuQ291bnQsICJBIikuRW5kKHhsVXApLlJvdyAn5YWD44OH44O844K/IEHliJfjgIDmnIDntYLooYzjgpLmsYLjgoHjgosKICAgIEZvciB3cm93ID0gMiBUbyBtYXhyb3cyCiAgICAgICAgd2RhdGUgPSB0c2guQ2VsbHMod3JvdywgIkEiKS5WYWx1ZSAgJ+aXpeS7mAogICAgICAgIGJhbmdvID0gdHNoLkNlbGxzKHdyb3csICJCIikuVmFsdWUgICfnpL7lk6Hnlarlj7cKICAgICAgICB3ZWVrX2RheSA9IHdlZWtkYXkod2RhdGUpCiAgICAgICAgd2RheSA9IERheSh3ZGF0ZSkKICAgICAgICAn56Wt5pel5Y+I44Gv5pel5puc5Y+I44Gv5Zyf5puc44Gq44KJWeWIl+aOoeeUqOOAgeW3puiomOS7peWkluOBr1jliJfmjqHnlKgKICAgICAgICBJZiBkaWNULmV4aXN0cyh3ZGF0ZSkgPSBUcnVlIE9yIHdlZWtfZGF5ID0gMSBPciB3ZWVrX2RheSA9IDcgVGhlbgogICAgICAgICAgICB3dGltZSA9IHRzaC5DZWxscyh3cm93LCAiWSIpLlZhbHVlCiAgICAgICAgRWxzZQogICAgICAgICAgICB3dGltZSA9IHRzaC5DZWxscyh3cm93LCAiWCIpLlZhbHVlCiAgICAgICAgRW5kIElmCiAgICAgICAgJ+S9huOBl+OAgeOCt+ODleODiOWLpOWLmeOBruOBv+OAgVjliJfjgpLnhKHmnaHku7bjgavmjqHnlKjjgZnjgosKICAgICAgICBJZiBkaWNNLmV4aXN0cyhiYW5nbykgPSBUcnVlIFRoZW4KICAgICAgICAgICAgSWYgZGljTShiYW5nbykoMikgPSBUcnVlIFRoZW4gICAgICAgJ+OCt+ODleODiOWLpOWLmeOBruWgtOWQiAogICAgICAgICAgICAgICAgd3RpbWUgPSB0c2guQ2VsbHMod3JvdywgIlgiKS5WYWx1ZQogICAgICAgICAgICBFbmQgSWYKICAgICAgICBFbmQgSWYKICAgICAgICBJZiBkaWNNLmV4aXN0cyhiYW5nbykgPSBUcnVlIFRoZW4KICAgICAgICAgICAgc2hlZXRfbm8gPSBkaWNNKGJhbmdvKSgwKSAgICfnpL7lk6Hnlarlj7flr77lv5zjga7pm4boqIjjgrfjg7zjg4jjga7jgrfjg7zjg4jnlarlj7cKICAgICAgICAgICAgd3JvdzIgPSBkaWNNKGJhbmdvKSgxKSAgICAgICfnpL7lk6Hnlarlj7flr77lv5zjga7pm4boqIjjgrfjg7zjg4jjga7ooYznlarlj7cKICAgICAgICAgICAgd2NvbDIgPSA3ICsgd2RheSAgICAgICAgICAgICflibLlopfmmYLplpPoqK3lrprjga7liJcKICAgICAgICAgICAgVGhpc1dvcmtib29rLldvcmtzaGVldHMoc2hlZXRfbm8pLkNlbGxzKHdyb3cyLCB3Y29sMikuVmFsdWUgPSB3dGltZQogICAgICAgIEVuZCBJZgogICAgTmV4dAogICAgdHdiLkNsb3NlCiAgICBBcHBsaWNhdGlvbi5DYWxjdWxhdGlvbiA9IHhsQ2FsY3VsYXRpb25BdXRvbWF0aWMKICAgIEFwcGxpY2F0aW9uLlNjcmVlblVwZGF0aW5nID0gVHJ1ZQogICAgTXNnQm94ICgi5a6M5LqGIikKRW5kIFN1Ygon44K344O844OI5oOF5aCx44Gu6KiY5oa277yI44K344O844OI55Wq5Y+344Go56S+5ZOh55Wq5Y+377yJClByaXZhdGUgU3ViIEdldFNoZWV0SW5mbyhCeVZhbCBzaGVldF9ubyBBcyBMb25nLCBCeVZhbCBkaWNNIEFzIE9iamVjdCkKICAgIERpbSB3cyBBcyBXb3Jrc2hlZXQKICAgIERpbSB3bm8gQXMgTG9uZwogICAgRGltIHdyb3cgQXMgTG9uZyAgICAgICAgJ+ekvuWToeeVquWPt+OBruihjOeVquWPtwogICAgRGltIHdyb3cyIEFzIExvbmcgICAgICAgJ+aZgumWk+OBruihjOeVquWPtwogICAgRGltIGJhbmdvIEFzIFZhcmlhbnQKICAgIERpbSBmbGFnIEFzIEJvb2xlYW4KICAgIGZsYWcgPSBGYWxzZQogICAgU2V0IHdzID0gV29ya3NoZWV0cyhzaGVldF9ubykKICAgICflh6bnkIblr77osaHlpJbjga7jgrfjg7zjg4jjga/jgrnjgq3jg4Pjg5fjgZnjgosKICAgIElmIHdzLk5hbWUgPSAi56Wd5pelIiBPciB3cy5OYW1lID0gIuODleOCqeODvOODnuODg+ODiCIgT3Igd3MuTmFtZSA9ICLmmYLplpPlpJYiIFRoZW4gRXhpdCBTdWIKICAgIElmIHdzLlJhbmdlKCJBMSIpLlZhbHVlID0gIuOCt+ODleODiOWLpOWLmSIgVGhlbgogICAgICAgIGZsYWcgPSBUcnVlCiAgICBFbmQgSWYKICAgICcxMOS6uuWIhue5sOOCiui/lOOBmQogICAgRm9yIHdubyA9IDEgVG8gMTAKICAgICAgICB3cm93ID0gKHdubyAtIDEpICogNiArIDUKICAgICAgICB3cm93MiA9IHdyb3cgKyAyCiAgICAgICAgYmFuZ28gPSB3cy5DZWxscyh3cm93LCAiQSIpLlZhbHVlCiAgICAgICAgJ+ekvuWToeeVquWPt+OBjOeZu+mMsuOBleOCjOOBpuOBhOOCjOOBsOOAgeOCt+ODvOODiOeVquWPt+OBqOihjOeVquWPt+OCkuiomOaGtuOBmeOCiwogICAgICAgIElmIGJhbmdvIDw+ICIiIFRoZW4KICAgICAgICAgICAgZGljTShiYW5nbykgPSBBcnJheShzaGVldF9ubywgd3JvdzIsIGZsYWcpICAgICAgICAgICAgICAn44K344O844OI55Wq5Y+344Go6KGM55Wq5Y+344Go44K344OV44OI5Yuk5YuZ44KS6KiY5oa2CiAgICAgICAgRW5kIElmCiAgICAgICAgd3MuUmFuZ2UoIkgiICYgd3JvdzIgJiAiOkFMIiAmIHdyb3cyKS5WYWx1ZSA9ICIiICAgICAgICAgICAgJ+aZgumWk+OCr+ODquOCogogICAgTmV4dApFbmQgU3ViCg==