マクロ(VBA)

マクロ（VBA）を使ってファイルの提出有無を一瞬で判別する方法

  /

ぺーパレスになって、データの提出が増えてくると面倒になってくるのが、

”提出有無の確認”

私は今から紹介するマクロを作るまでは、ファイル名とリストを照らし合わせて、一つ一つ提出の有無を確認しておりました。

しかし、今から紹介するマクロを使えば、指定のフォルダに誰がファイルを提出してて、誰が提出していないのか一瞬でわかるようになります。

かなり、汎用的なコードなので、あなたも明日からすぐに使えると思います。

では早速説明していきます。

目次

今回のマクロの下準備

チェックリスト

今から紹介するマクロを使うためには2つの下準備が必要となります。

  1. ファイル名の頭に提出者を識別できるワード
  2. 提出者の一覧

まず、①については、ファイル名の頭に必ず提出者がわかるワード、例えば社員番号とか事業所番号のようなファイル名だけで提出者を識別できるワードを入力するルールにする必要があります。

111111＿山田太郎0720.xlsx

5555_埼玉事業所0609.xlsx

↑みたいなファイル名にする必要があります。

提出確認

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

要するにこの一覧に提出の有無をチェックしていくのです。

提出確認2

下準備はこれぐらいです。

では、マクロの具体的な説明をしていきます。

提出確認のマクロの構造

マクロでどうやって提出の確認をするか？その流れは結構単純です。

  1. 指定フォルダにあるファイル名を全部吸い上げる
  2. そのファイル名の頭のワードと提出者の一覧を突き合わせる
  3. あれば⇒●　なければ⇒空白

たった、これだけです。

提出確認のマクロ全文！

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
詳しい解説は↓動画でやっていますのでそちらをご確認ください。

データなら提出確認が一瞬で終わる、紙はそれが無理

やっぱり業務効率化の一歩目はペーパレス化だと思います。

上司の効率化無茶ぶりに悩んでいる人はまず、ペーパレスできる書類が無いかどうか確認するのが吉。

関連記事