テレワーク管理表を作る(マクロで複数のExcelシートからデータを自動取得する)

入力の効率化
2021.05.06

コロナ禍

コロナ禍を受けて、私の会社で一部休業措置とテレワークを実施したときのこと。誰がいつ休業又はテレワークをしているかを把握できるように管理表を作りました。各部署作成の1カ月分の予定表を取りまとめ管理表を作成し、誰でもいつでも見ることができるようにサーバーで共有しました。ところが上司から「今日〇〇さんは出社のはずなのに、なぜ休業しているのか。管理表が更新できていない」とのお叱りと「毎日、朝一と午後一で更新するように」との命令。手作業で毎日2回も更新していたらそれだけでかなりの時間を取られてしまうので、マクロで管理表を自動更新することにしました。

やりたいこと

朝8時と昼1時の1日2回、各部署全ての予定表のデータを取得し管理表を更新する作業を自動化する。

各部署が管理する予定表を作成する

  • 予定表は各部署の所属長に作成してもらいますが、書式は統一化します。
  • 予定表は誰でも編集・閲覧できるようにするためサーバー上に置いて「共有」設定します。
  • テレワーク「〇」と一時帰休「帰休」以外の文字等が入力できないように「データの入力規則」を設定しています。※「入力規則」と「共有設定」方法は下記動画参照

各部署の予定表を取りまとめる管理表を作成する

管理表のイメージ

管理表は予定表(3部署)を取りまとめた形になります。

予定表のデータを管理表に転記するマクロコード

予定表を一つずつ開いてデータを読み込み、そのデータを管理表の所定の場所に貼り付けるマクロコードです。社員番号を元にデータの紐付けを行っています。それから月が変わるときシートをコピーして使いたいので、マクロコードはシートモジュールに記入します。

'※シートモジュールに記入
Sub update214()          '月が変わるとき要修正「214」=「2021年4月」
Application.ScreenUpdating = False

    Dim f As Object, g As Object
        For Each f In CreateObject("Scripting.FileSystemObject").GetFolder _
               ("●●予定表が入っているフォルダのパスを入れる●●").Files     
            If InStr(f.Type, "Excel") > 0 Then
                Dim Target As Workbook, TargetWSH As Worksheet, ThisWSH As Worksheet
                Workbooks.Open Filename:=f, ReadOnly:=True, Notify:=False
                Set Target = ActiveWorkbook
                Set TargetWSH = Target.Worksheets("21_4月")         '月が変わるときシート名を要修正
                Set ThisWSH = ThisWorkbook.Worksheets("21aplil")    '月が変わるときシート名を要修正
                    For n = 6 To TargetWSH.Cells(Rows.Count, 2).End(xlUp).Row
                        SyainNo = TargetWSH.Cells(n, 2)
                        Set rcd = ThisWSH.Range("b:b").Find(what:=SyainNo, LookAt:=xlWhole)
                            If Not rcd Is Nothing Then
                                Dim s(30) As String, u(30) As String
                                For t = 0 To 30
                                    s(t) = TargetWSH.Cells(n, 4 + t)
                                Next t
                                rcd.Offset(0, 2).Resize(1, 31) = s
                            End If
                    Next n
                Target.Close savechanges:=False
            End If
        Next f
    ThisWSH.Cells(2, 31) = Now
Application.ScreenUpdating = True

msgbox"更新完了しました"
End Sub

マクロコードを実行するボタンを設置する

ボタンを押すといきなりマクロが実行されてしまうので、ボタンを押した後、マクロを実行するかどうかを確認するボタンを表示するマクロコードを作成します。YESの場合は、上記マクロを実行します。NOの場合は実行を中止します。

'※シートモジュールに記入
Sub yes_no()
　　　Dim rc As VbMsgBoxResult
　　　rc = MsgBox("更新しますか？", vbYesNo + vbQuestion)
　　　If rc = vbYes Then
    　　　Call update214     　　　　  '予定表のデータを管理表に転記するマクロコード(上記)の名前
　　　　　MsgBox "更新完了しました" & vbCrLf & Now
　　　Else
    　　　MsgBox "処理を中止します", vbCritical
　　　End If
End Sub

上記、マクロコードをシートモジュールに記入した後、ワークシート上にフォームコントロールボタンを配置して、マクロコードとの関連づけを行ってください。

管理表の自動実行を設定する

マクロでタイマーを設定する

時間(8:00と13:00)が来たら自動でマクロコードを実行します。これにより実行ボタンの押し忘れもなくなります。下記のコードをワークブックモジュールに記入します。ブックを開いたときにタイマーがセットされます。ただし、自動実行するためには、管理表のExcelブックを開いていることが条件となります。ブックを閉じている状態では起動しません。

'ThisWorkbookモジュールに記入
Private Sub Workbook_Open()
   Application.OnTime TimeValue("8:00:00"), "Sheet1.update214"　　　　 'シート名.マクロコードの名前
   Application.OnTime TimeValue("13:00:00"), "Sheet1.update214" 　　　
End Sub

タスクスケジューラーでタイマーを設定する

Excelブックを開く動作も自動化させたい場合は、まずWindows10の「タスクスケジューラー」で指定時間に自動的に開くように設定して、管理表が開いたしたときに更新プログラムを起動させるマクロを組みます。タスクスケジューラーの設定は下記動画を参照ください。

'ThisWorkbookモジュールに記入
Private Sub Workbook_Open()
    Sheet1.update214　　　　　　　 'シート名.マクロコードの名前
End Sub

コメント

タイトルとURLをコピーしました