外部Q&A:下記添付のVBAに改修を加え、翌日の件数を表示させ-1170616 | IS03井戸端会議|Android au

auのアンドロイド端末、IS03に関する情報を中心に集めた情報の受発信サイトです。今後発売されるアンドロイド端末の情報や、IS03のレビューを掲載していきます。

質問:【下記添付のVBAに改修を加え、翌日の件数を表示させ】

下記添付のVBAに改修を加え、翌日の件数を表示させる処理を追加したいです。
なお、土日祝日はスキップする処理にしたいです。
例)金曜日にこのマクロを実行したら翌週の月曜日の件数を表示させる。
初心者で苦戦しています。
どなたか教えていただけると幸いです。
'【追加処理】明日の日付で検索を実行する Sub Auto_Date() '【変数の宣言】 Dim Tomorrow As Variant '作業予定日(入力値) Tomorrow = Date Tomorrow = Format(Tomorrow, "yyyy/mm/dd") Call main(Tomorrow) End Sub Private Sub main(Tomorrow) '【変数の宣言】 Dim FoundCell As Variant '作業予定日(マスターファイル上) Dim FastAddress As Variant '最初の検索セルのアドレス Dim FatCnt As Variant 'Fat利変の件数 Dim ThinCnt As Variant 'Thin利変の件数 Dim Data(34) As Variant 'マスターデータ Dim Cnt As Integer 'Data(*)の* Dim LastRow As Variant 'Fat利変欄の最終行 Dim LastCell As Variant '抽出したデータの最終行 Dim Lastaddress As Variant 'LastCellのアドレス Dim CheckRow As Variant 'チェックするデータの行 Dim CheckFlag As Variant '「作業日」欄の入力有無のフラグ (0=問題なし、1以上=問題あり) '【パス、ファイル名の定義】 FSPath = "\\mcamsnsfs01\2012MCGPC_UNYO\10.スポット作業" FatPath = "01.利用者変更作業\作業利用ドキュメント" ThinPath = "03.利用者変更作業(ThinPC)" FatMaster = "【マスターファイル】PC(Lenovo)利用者変更作業.xls" ThinMaster = "【マスターファイル】PC(Lenovo)利用者変更作業(ThinPC).xls" 'Fat利変、Thin利変の件数を0と定義する FatCnt = 0 ThinCnt = 0 '********** '①FAT利変のマスターをチェックする '********** Application.ScreenUpdating = False 'マスターファイルを読み取り専用で開く Workbooks.Open Filename:=FSPath & "\" & FatPath & "\" & FatMaster, ReadOnly:=True '作業予定日欄を明日の日付で検索する Set FoundCell = Range("W:W").Find(What:=Tomorrow, LookIn:=xlValues, LookAt:=xlWhole) '明日の日付がなかったら処理をしない If FoundCell Is Nothing Then Else FastAddress = FoundCell.Address Do FoundCell.Offset(0, 10).Activate 'ステータス欄に"キャンセル"と記載されている場合は処理をしない If ActiveCell = "キャンセル" Then Else ActiveCell.Offset(0, -32).Activate 'マスタファイルのデータを取得する For Cnt = 0 To 33 Data(Cnt) = ActiveCell.Offset(0, Cnt) Next '利変マスタチェックツールに取得したデータを入力する Windows(ThisWorkbook.Name).Activate Worksheets("Sheet1").Select LastRow = Range("G24").End(xlUp).Row + 1 Cells(LastRow, "G") = Data(0) '依頼番号 Cells(LastRow, "H") = Data(22) '作業予定日 Cells(LastRow, "I") = Data(23) '開始予定時刻 Cells(LastRow, "J") = Data(25) '作業担当者 Cells(LastRow, "K") = Data(26) '作業日 Cells(LastRow, "L") = Data(27) '開始時刻 Cells(LastRow, "M") = Data(28) '完了時刻 Cells(LastRow, "N") = Data(31) 'リモート方法 Cells(LastRow, "O") = Data(32) 'ステータス Cells(LastRow, "P") = Data(33) '備考 Windows(FatMaster).Activate '明日対応分のFat利変の件数をカウントする FatCnt = FatCnt + 1 FoundCell.Activate End If '次の作業予定日を探す Set FoundCell = Range("W:W").FindNext(FoundCell) Loop Until FoundCell.Address = FastAddress End If Windows(FatMaster).Close

以下ベストアンサー

Sub Auto_Date()のTomorrow = Dateを Tomorrow = NextWorkDay(Year(Date),Month(Date),Day(Date))に変えて以下の関数を貼ってください。
翌日の業務日が検索されます。
Function monthDay(Y, M) Dim D(12) D(1) = 31 D(2) = 28 D(3) = 31 D(4) = 30 D(5) = 31 D(6) = 30 D(7) = 31 D(8) = 31 D(9) = 30 D(10) = 31 D(11) = 30 D(12) = 31 If isLeapYear(Y) Then D(2) = D(2) + 1 monthDay = D(M) End Function Function isLeapYear(Y) isLeapYear = (Y Mod 400 = 0) Or ((Y Mod 4 = 0) And (Y Mod 100 <> 0)) End Function Function weekDayDate(Y, M, week, youbi) Dim D As Integer Dim count As Integer Dim find As Boolean count = 0 For D = 1 To monthDay(Y, M) If youbi = Weekday(DateSerial(Y, M, D)) Then count = count + 1 If count = week Then find = True Exit For End If Next If find Then weekDayDate = DateSerial(Y, M, D) End If End Function Function IsHoliday(Y, M, D) If Weekday(DateSerial(Y, M, D)) = vbSunday Or Weekday(DateSerial(Y, M, D)) = vbSaturday Then IsHoliday = True Exit Function End If Dim mydate() ReDim mydate(1 To 16) mydate(1) = DateSerial(Y, 1, 1) mydate(2) = DateSerial(Y, 1, 15) ',成人の日 mydate(3) = DateSerial(Y, 2, 11) '建国記念日 mydate(4) = DateSerial(Y, 3, 23) '春分の日 mydate(5) = DateSerial(Y, 4, 29) ',昭和の日 mydate(6) = DateSerial(Y, 5, 3) ',憲法記念日 mydate(7) = DateSerial(Y, 5, 4) ',みどりの日 mydate(8) = DateSerial(Y, 5, 5) ',こどもの日 mydate(9) = DateSerial(Y, 7, 20) ',海の日 mydate(10) = DateSerial(Y, 8, 11) ',山の日 mydate(11) = DateSerial(Y, 9, 15) ',敬老の日 mydate(12) = DateSerial(Y, 9, 23) ',秋分の日 mydate(13) = DateSerial(Y, 10, 10) ',体育の日 mydate(14) = DateSerial(Y, 11, 3) ',文化の日 mydate(15) = DateSerial(Y, 11, 23) ',勤労感謝の日 mydate(16) = DateSerial(Y, 12, 23) ',天皇誕生日 If Y >= 2000 Then mydate(2) = weekDayDate(Y, 1, 2, vbMonday) ',成人の日 mydate(13) = weekDayDate(Y, 10, 2, vbMonday) ',体育の日 End If If Y >= 2004 Then mydate(9) = weekDayDate(Y, 7, 3, vbMonday) ',海の日0 End If If Y >= 2004 Then mydate(11) = weekDayDate(Y, 9, 3, vbMonday) ',敬老の日 End If mydate(4) = DateSerial(Y, 3, Int(0.24242 * Y - Int(Y / 4) + 35.84)) '春分の日 mydate(12) = DateSerial(Y, 9, Int(0.24204 * Y - Int(Y / 4) + 39.01)) '秋分の日 If Weekday(DateSerial(Y, 4, 29)) = vbSunday Then mydate(5) = DateSerial(Y, 4, 30) '昭和の日(振替日) End If If Weekday(DateSerial(Y, 5, 6)) = vbMonday Or Weekday(DateSerial(Y, 5, 6)) = vbTuesday Or Weekday(DateSerial(Y, 5, 6)) = vbWednesday Then Select Case Weekday(DateSerial(Y, 5, 6)) Case vbMonday mydate(6) = DateSerial(Y, 5, 3) '憲法記念日 mydate(7) = DateSerial(Y, 5, 4) 'みどりの日 mydate(8) = DateSerial(Y, 5, 6) 'こどもの日(振替日) Case vbTuesday mydate(6) = DateSerial(Y, 5, 3) '憲法記念日 mydate(7) = DateSerial(Y, 5, 5) 'こどもの日 mydate(8) = DateSerial(Y, 5, 6) 'みどりの日(振替日) Case vbWednesday mydate(6) = DateSerial(Y, 5, 4) 'みどりの日 mydate(7) = DateSerial(Y, 5, 5) 'こどもの日 mydate(8) = DateSerial(Y, 5, 6) '憲法記念日(振替日) End Select End If arr = Array(3, 4, 10, 12, 14, 15) For i = 0 To 5 If Weekday(DateValue(mydate(arr(i)))) = vbSunday Then mydate(arr(i)) = DateValue(mydate(arr(i))) + 1 '(振替休日) End If Next i ret = Application.Match(Day(DateValue(mydate(12))), Array(21, 22, 23), 0) If IsError(ret) = False Then If Weekday(DateValue(mydate(12))) = vbWednesday And Day(DateValue(mydate(12))) <> 24 Then ReDim Preserve mydate(1 To 17) mydate(17) = DateValue(mydate(12)) - 1 '国民の休日 End If End If For i = 1 To UBound(mydate) If DateSerial(Y, M, D) = mydate(i) Then IsHoliday = True Exit Function End If Next i IsHoliday = False End Function Function NextWorkDay(Y, M, D) i = 1 If IsHoliday(Y, M, D + i) = True Then Do i = i + 1 Loop Until IsHoliday(Y, M, D + i) = False End If NextWorkDay = DateSerial(Y, M, D + i) End Function

https://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q141718176742017-03-20 16:59:34