【VBA】対象期間内チェックの方法

前提・実現したいこと

　【実施したいこと】
先週月曜日～今週月曜日までの8日間が対象ファイル内の日付に該当しているかをチェックしたい。

VBA初心者です。アクセスログの分析ツールを作成しております。（週一で分析）
ロジックが思い浮かばないため、皆様のお知恵をお貸しいただけますと幸いです。

・ファイル数は連休の場合も含み２～６個で、ファイル内の日付は全ファイル合わせて9日分ほどあり、分刻みで集計を行うため万単位のデータがあります。
・祝日など何もない通常の場合はファイルの中身は以下のようになっております。
1つめのファイル：先々週の土曜日の途中から、先々週の日曜日、先週の月曜日、先週の火曜日の途中まで
2つめのファイル：先週の火曜日の途中から、先週の水曜日の途中まで
3つめのファイル：先週の水曜日の途中から、先週の木曜日の途中まで
4つめのファイル：先週の木曜日の途中から、先週の金曜日の途中まで
5つめのファイル：先週の金曜日の途中から、先週の土曜日の途中まで
6つめのファイル：先週の土曜日の途中から、先週の日曜日、今週の月曜日、今週の火曜日の途中まで

しかし、連休や祝日があった場合はファイル数が変動し（出勤日にログファイルを取得するため）、それに伴いファイル内の曜日も上記とは異なってしまいます。
ファイル数が変動してもログは毎日記録されているので、例えばファイル数が３つしかない場合でも先週の月曜日～今週の月曜日の8日間は３ファイルの中に詰め込まれて存在します。

ファイル数とファイル内の曜日が固定ではないため、コードの組み方で苦戦しております。
「試したこと」に記載のコードを考えてみましたが、下記の点で詰まってしまいました。
・8日間全て見つかった場合はcount変数に「8」が入り、その結果でOKでもいいかもしれないが、全ファイルを参照するので無駄な作業が多い。
⇒該当した曜日があった場合、以降はその曜日チェックのみを飛ばしたい。
・該当しない曜日があった場合、「〇〇曜日はありませんでした。」とのメッセージを表示させるために「msg_（曜日）」変数へ格納する処理を入れているが、全ファイルを参照するためどこかのファイルで該当しない曜日があるのは当然。
全ファイルを参照した上で8日間に該当する日付がない場合、「〇〇曜日がありませんでした。」と表示するにはどのようにコードを組めばよいか。

以上となります。
find関数ではなく別の関数を使用した方が良い、根本的にコードの組み方がおかしい等、何かアドバイスいただけますと幸いです。
お手数をおかけいたしますが、よろしくお願いいたします。

試したこと

vba
1
2'型変換などあまり重要でない処理は省いております。
3
4Sub filecheck()
5
6Dim folderPath,filename As String
7Dim num,LastRow,i,count,x As Long
8Dim lastMonday,Tuesday,Wednesday,Thursday,Friday,Saturday,Sunday,thisMonday As date
9Dim msg_lastMonday, msg_Tuesday,msg_Wednesday,msg_Thursday,msg_Friday,msg_Saturday,msg_Sunday,msg_thisMonday As String
10Dim sh_act As Worksheet, sh_wrk As Worksheet
11
12
13
14folderPath = ThisWorkbook.Worksheets(1).Cells(4, 5)  '「フォルダ選択」ボタンを押下し、選択されたディレクトリを「folderPath」へ格納する
15
16
17Set sh_act = ActiveSheet
18filename = Dir(folderPath & "*.xls")                 '拡張子が「.xls」のファイルをすべて取得する。
19
20
21lastMonday = ThisWorkbook.Worksheets(1).Cells(8, 5)    '作業者が先週の月曜日をE8セルに入力し、その日付を「lastMonday」へ格納する
22
23
24Tuesday = DateAdd("d", 1, lastMonday)                       'lastMonday2 + 1日後⇒先週の火曜日
25Wednesday = DateAdd("d", 2, lastMonday)                     'lastMonday2 + 2日後⇒先週の水曜日
26Thursday = DateAdd("d", 3, lastMonday)                      'lastMonday2 + 3日後⇒先週の水曜日
27'...今週の月曜日まで
28
29 count = 0          '日付が見つかった場合のカウント用
30 i = 0              'ループのカウント用
31
32
33Do While i < num 　　'「num」は別途ファイル数チェックの戻り値です。（ファイル数分ループする）    
34
35 Set sh_wrk = Workbooks.Open(folderPath & "\" & filename).Sheets(1)         'ファイルを開く
36  
37 LastRow = sh_wrk.Range("A1").End(xlDown).Row                               'ログファイルの最終行
38
39　　i = i + 1          '何番目のブックか数える
40    x = 1　　　　　　　　'行数カウント用
41
42　　　
43          'ファイル内に「先週の月曜日の日付があるか」を検索する。
44
45          Set myRange = Range("A" & x & ":" & "A" & LastRow)
46          Set myObj = myRange.find(lastMonday, LookAt:=xlPart)                                                                　　　　　　　
47　　　　　　　If myObj Is Nothing Then
48                   msg_lastMonday = "'" & lastMonday & "'はありませんでした"
49                 
50   　　　　　 Else
51                       count = count + 1       '「先週の月曜日」が見つかった場合、を変数「count」に１を足す                                                                               
52    
53              End If
54    
55           'ファイル内に「先週の火曜日の日付があるか」を検索する。
56
57          Set myRange = Range("A" & x & ":" & "A" & LastRow)
58          Set myObj = myRange.find(Tuesday, LookAt:=xlPart)   
59
60　　　　　　　If myObj Is Nothing Then
61                   msg_Tuesday = "'" & Tuesday & "'はありませんでした"
62                  
63             Else
64                         count = count + 1       '「先週の火曜日」が見つかった場合、を変数「count」に１を足す
65
66
67　　　　　　'...今週の月曜日まで続きます。
68
69                                                                                                                       
70filename = Dir()
71 Loop
72
73End Sub
74                        
75

行動規範の内容に同意します

回答2件

ベストアンサー

やりたいことは、
先週の月曜日～今週の月曜日の8日間の日付がExcelファイル内に抜けなく存在するかどうかのチェックですね。

ロジックの一例

text
1①日付を格納する配列を用意して、8日分の日付を格納する。
2　別途、その日付が存在するかどうかを格納する配列も用意する。
3
4②Dir関数で該当ファイルをループで取得して開く。
5
6　③ For Nextループで日付を検索する。
7　　日付存在配列をチェックしてその日付が存在しなければ
8　　　シートのログデータをFindで検索。
9　　　　見つかれば、日付存在配列にTrueを代入
10
11④ループで日付存在配列をチェックする。
12　日付が存在しない場合、その日付を文字列に連結していく。
13
14
15⑤文字列が "" なら「すべてありました」とメッセージ
16　""でなければ、文字列 & 「がありませんでした」とメッセージ

上記をコード化すると、

vba
1   '①
2    Dim LogDate(0 To 7) As Date
3    Dim LogDateExist(0 To 7) As Boolean
4    LogDate(0) = #4/1/2019#
5    For i = 1 To 7
6        LogDate(i) = LogDate(0) + i
7    Next
8
9    '②
10    Dim i As Long
11    filename = Dir(folderPath & "*.xls")
12    Do Until filename <> ""
13        With Workbooks.Open(folderPath & "\" & filename).Sheets(1) 
14            '③
15            For i = 0 To 7
16                If Not LogDateExist(i) Then
17                    Set findRng = .Range("A1:A" & LastRow).Find(LogDate(i), LookAt:=xlPart) 
18                    If Not findRng Is Nothing Then
19                        LogDateExist(i) = True
20                    End If
21                End If
22            Next
23        End With
24        filename = Dir()
25    Loop
26
27    '④
28    Dim NoDates As String
29    For i = 0 To 7
30        If Not LogDateExist(i) Then
31            NoDates = NoDates & "，" & Format(LogDate(i), "m/d(aaa)")
32        End If
33    Next
34
35    '⑤
36    If NoDates = "" Then
37        MsgBox "すべてありました。"
38    Else
39        MsgBox Mid(NoDates, 2) & "がありませんでした。"
40    End If

変数宣言など細かい部分は省略しているの実際は動作しません。
ロジックの参考にしてください。

高速化

アクセスログということなので、データは日付/時刻の昇順になってますよね。
ならば、Findの代わりにMatch関数を使うと高速化できます。
速度に不満がある場合は変更してください。

提示のコードで気になる点

Dim folderPath,filename As String

これは、folderPath, filename をString型で宣言したつもりでしょうが、
folderPath は型宣言を省略したことになり Variant型になります。
面倒でも、

Dim folderPath As String, filename As String

と一つずつ宣言してください。
他の変数宣言も同様です。

投稿2019/04/08 06:04

編集2019/04/09 00:40

hatena19

総合スコア34362

satomori

2019/04/08 07:50

ご丁寧にご回答くださり本当にありがとうございます。コードが綺麗で非常に分かりやすく感動いたしました。教えていただいたコードを元に再作成してみます。また、変数宣言時の注意点につきましても恥ずかしながら存じ上げておりませんでした。教えてくださりありがとうございます。

行動規範の内容に同意します

ファイル数とファイル内の曜日が固定ではないため、コードの組み方で苦戦しております。

特定のフォルダーにある事が前提ですが、フォルダの階層読み込みを使うといいでしょう。私のプロフィールにフォルダの階層読込のコードが書かれたURLがありますので是非お使い下さい。

ファイル名に日付が挿入されているなら、VBAには「Date(日付)型」という型が存在するので型に当てはめれば日付を取得することが出来ます。「〇〇曜日はありませんでした。」と表示するのも可能です。

'ファイル内に「先週の月曜日の日付があるか」を検索する。

ここのコメントは何をしていますか？
基本的に同じコードならFor文が存在しますので使いましょう。

VBA
1Dim lastMonday,Tuesday,Wednesday,Thursday,Friday,Saturday,Sunday,thisMonday As date
2Dim msg_lastMonday, msg_Tuesday,msg_Wednesday,msg_Thursday,msg_Friday,msg_Saturday,msg_Sunday,msg_thisMonday As String
3Dim sh_act As Worksheet, sh_wrk As Worksheet

ここも配列を使えば、こんなに作る必要はありませんね。
こちら等を参考に配列の勉強をした方がより洗練されたソースコードが書けますよ。

投稿2019/04/08 02:44

編集2019/04/08 03:16

stdio

総合スコア3307

satomori

2019/04/08 04:54

早速ご回答くださりありがとうございます。フォルダ階層のコード使わせていただきます。＞ここのコメントは何をしていますか？ファイルを１つずつ開き、「先週の月曜日」の日付は存在するか、「先週の火曜日の」の日付は存在するか、・・を「今週の月曜日」まで処理を行っております。（良い処理だとは思えませんが。。）教えていただいたfor文と配列を使用し、再度考えてみます。ありがとうございました。

stdio

2019/04/08 05:11

ソースは途中までしか載せていないようですし、追加でアドバイスするのもなんですが、EXCELのセル内にフォルダの場所を記載させるのはあまりにも使い勝手が悪いように感じます。別のエクセルやシートに記載させてするようにすれば、見なくていいファイルと見るべきファイルが分かれますのでおススメです。後、一点「フォルダの階層読込」はフォルダのパスを取得してくるだけで、データを開く処理はそちらで書かなければ行けません。動的にフォルダやファイルの名前を取得できるだけですので過信しないようにお願いします。何か不具合でもありましたら、教えて下さい。

satomori

2019/04/08 05:27

追記のアドバイスをしていただきありがとうございます。フォルダの場所の件ですが、こちらのコード内には記載しておりませんでしたが「FileDialog」関数で作業者にディレクトリを選択させるようにしておりました。記載不足で申し訳ございません。。また、フォルダの階層読込につきまして承知いたしました。ご丁寧にありがとうございます。

stdio

2019/04/08 05:58

FileDialogでユーザーに選択させているなら、階層読込を使う必要は薄くなりますね。私の場合はRPAの業務が多かったので階層読込を使った方が便利だったりするのですよ...

satomori

2019/04/08 06:53

確かにそうですね。。 RPAですか。調べてみましたがマクロよりも広範囲で自動化出来るのですね。

stdio

2019/04/08 07:10

流石にOCRとか画像分析は出来ませんが、windows限定ならRPAの大半の事はVBAでも可能ですよ。

satomori

2019/04/08 07:44

そうなのですね。勉強になります。