質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

新規登録して質問してみよう
ただいま回答率
85.50%
VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

Q&A

解決済

2回答

2790閲覧

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

satomori

総合スコア15

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

0グッド

0クリップ

投稿2019/04/08 02:29

前提・実現したいこと

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

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

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

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

ファイル数とファイル内の曜日が固定ではないため、コードの組み方で苦戦しております。
「試したこと」に記載のコードを考えてみましたが、下記の点で詰まってしまいました。
・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」に1を足す 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」に1を足す 65 66 67      '...今週の月曜日まで続きます。 68 69 70filename = Dir() 71 Loop 72 73End Sub 74 75

気になる質問をクリップする

クリップした質問は、後からいつでもMYページで確認できます。

またクリップした質問に回答があった際、通知やメールを受け取ることができます。

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

guest

回答2

0

ベストアンサー

やりたいことは、
先週の月曜日~今週の月曜日の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

総合スコア33620

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

satomori

2019/04/08 07:50

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

0

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

特定のフォルダーにある事が前提ですが、フォルダの階層読み込みを使うといいでしょう。私のプロフィールにフォルダの階層読込のコードが書かれた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

早速ご回答くださりありがとうございます。 フォルダ階層のコード使わせていただきます。 >ここのコメントは何をしていますか? ファイルを1つずつ開き、「先週の月曜日」の日付は存在するか、 「先週の火曜日の」の日付は存在するか、・・を「今週の月曜日」まで処理を行っております。 (良い処理だとは思えませんが。。) 教えていただいた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

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

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

15分調べてもわからないことは
teratailで質問しよう!

ただいまの回答率
85.50%

質問をまとめることで
思考を整理して素早く解決

テンプレート機能で
簡単に質問をまとめる

質問する

関連した質問