スポンサーリンク
ぺーパレスになって、データの提出が増えてくると面倒になってくるのが、
”提出有無の確認”
私は今から紹介するマクロを作るまでは、ファイル名とリストを照らし合わせて、一つ一つ提出の有無を確認しておりました。
しかし、今から紹介するマクロを使えば、指定のフォルダに誰がファイルを提出してて、誰が提出していないのか一瞬でわかるようになります。
かなり、汎用的なコードなので、あなたも明日からすぐに使えると思います。
では早速説明していきます。
スポンサーリンク
目次
今回のマクロの下準備

今から紹介するマクロを使うためには2つの下準備が必要となります。
- ファイル名の頭に提出者を識別できるワード
- 提出者の一覧
まず、①については、ファイル名の頭に必ず提出者がわかるワード、例えば社員番号とか事業所番号のようなファイル名だけで提出者を識別できるワードを入力するルールにする必要があります。
111111_山田太郎0720.xlsx
5555_埼玉事業所0609.xlsx
↑みたいなファイル名にする必要があります。

次に②についてですが、事前に①で入力したワードが網羅されている提出者一覧を作成しておく必要があります。
要するにこの一覧に提出の有無をチェックしていくのです。

下準備はこれぐらいです。
では、マクロの具体的な説明をしていきます。
提出確認のマクロの構造
マクロでどうやって提出の確認をするか?その流れは結構単純です。
- 指定フォルダにあるファイル名を全部吸い上げる
- そのファイル名の頭のワードと提出者の一覧を突き合わせる
- あれば⇒● なければ⇒空白
たった、これだけです。
提出確認のマクロ全文!
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 |
Sub Macro1() Dim fol_path As String Dim f_name As String Dim i As Long Dim tate As Long Dim yoko As Long Dim tatef As Long Dim yokof As Long Dim shname As String Dim shname2 As String Dim ix_S As Long Dim ws As Worksheet, flag As Boolean tate = 3 yoko = 1 shname = "提出状況" shname2 = "ファイル名一覧" ThisWorkbook.Sheets(shname2).Activate ThisWorkbook.Sheets(shname2).Range(Cells(1, 1), Cells(4000, 1000)).ClearContents ThisWorkbook.Sheets(shname).Activate ThisWorkbook.Sheets(shname).Range(Cells(4, 3), Cells(50000, 1000)).ClearContents ThisWorkbook.Sheets(shname2).Activate Do Until ThisWorkbook.Sheets("main").Cells(tate, 2) = "" fol_path = ThisWorkbook.Sheets("main").Cells(tate, 2) f_name = Dir(fol_path & "\*") i = 5 ThisWorkbook.Sheets(shname2).Cells(1, yoko) = fol_path ThisWorkbook.Sheets(shname2).Cells(2, yoko) = "のファイル一覧" ThisWorkbook.Sheets(shname2).Cells(3, yoko) = ThisWorkbook.Sheets("main").Cells(tate, 1) ThisWorkbook.Sheets(shname2).Cells(4, yoko) = "ファイル名" Do Until f_name = "" ThisWorkbook.Sheets(shname2).Cells(i, yoko).Value = f_name i = i + 1 f_name = Dir Loop tate = tate + 1 yoko = yoko + 1 Loop tate = 3 yoko = 1 tatef = 3 yokof = 3 Do Until ThisWorkbook.Sheets("main").Cells(tate, yoko) = "" ThisWorkbook.Sheets(shname).Select ThisWorkbook.Sheets(shname).Cells(tatef, yokof) = ThisWorkbook.Sheets("main").Cells(tate, yoko) ThisWorkbook.Sheets(shname).Cells(tatef - 1, yokof) = ThisWorkbook.Sheets("main").Cells(tate, yoko + 2) tate = tate + 1 yokof = yokof + 1 Loop tate = 5 yoko = 1 tatef = 3 yokof = 3 Sheets(shname).Select Columns("A:A").Select Range("A4").Activate Do Until ThisWorkbook.Sheets(shname2).Cells(tate, yoko) = "" Do Until ThisWorkbook.Sheets(shname2).Cells(tate, yoko) = "" Set wkObject = Selection.Find(Left(ThisWorkbook.Sheets(shname2).Cells(tate, yoko), 4), Lookat:=xlWhole) If wkObject Is Nothing Then Else wkObject.Activate ix_S = ActiveCell.Row If ThisWorkbook.Sheets(shname).Cells(ix_S, yokof) = "" Then ThisWorkbook.Sheets(shname).Cells(ix_S, yokof) = "●" End If End If tate = tate + 1 Loop yoko = yoko + 1 tate = 5 yokof = yokof + 1 Loop MsgBox "終了" End Sub |
データなら提出確認が一瞬で終わる、紙はそれが無理
やっぱり業務効率化の一歩目はペーパレス化だと思います。
上司の効率化無茶ぶりに悩んでいる人はまず、ペーパレスできる書類が無いかどうか確認するのが吉。