[[20190620091013]]　『(マクロ)リストから日付を参照しその範囲を求める』（マイン）　ページの最後に飛ぶ

『(マクロ)リストから日付を参照しその範囲を求める方法』（マイン）

いつもお世話になっております。

日付リストから処理月のあるセル範囲(先頭・最終)の求め方について
アドバイスの程よろしくお願いいたします。

(シートの状況)

・処理月の入力セル(6/1と入力されてある)
　ActiveSheet.Range("B1")

・日付リスト
　シート内のA列に「土日祝日」のみ抽出した日付値が数年分入力

　Worksheets("マスタ").Range("A2:A" & 最終行)

(処理について)

例えば、処理月が「6月」の場合

　マスタのセル範囲から処理月のある

　「先頭行番号」と「最終行番号」を求めたいと考えております。

※日付リストから「6月」の範囲を特定する場合6月の土日祝日は

　A177=6/1
　・
　・
　・
　6/2.6/8.6/9.6/15.6/16.6/22.6/23.6/29
　・
　・
　・
　A186=6/30

　結果

　r=177
　c=186

　以上がイメージです。

　何卒アドバイスの程よろしくお願いいたします。

＜使用 Excel：Office365、使用 OS：Windows10 ＞

 こんにちは　＾＾
＞＞ActiveSheet.Range("B1") 
＞＞Worksheets("マスタ").Range("A2:A" & 最終行) 
って同じシートでしょうか
単純に行を求めるだけなら、一案ですが
処理対象月を
ループで見つかれば行を取得、抜け出し。
翌月を
ループで見つかれば行を取得後マイナス1、抜け出し
何かでも調べることは出来るかと。
（隠居じーさん） 2019/06/20(木) 14:30

Sub main()

    Dim srow As Long, erow As Long, ip As Range, c As Range
    Set ip = Application.InputBox(prompt:="処理月の入力セルを選択してください", Type:=8)
    For Each c In Sheets("マスタ").Range("A2:A" & Rows.Count).SpecialCells(2)
        If Month(ip) = Month(c.Value) And Year(ip) = Year(c.Value) Then
            If srow = 0 Then srow = c.Row
        Else
            If srow > 0 Then erow = c.Row - 1: Exit For
        End If
    Next c
    MsgBox "先頭行番号:" & srow & vbLf & "最終行番号:" & erow
End Sub
（mm） 2019/06/20(木) 14:31

別案です。休日以外は行追加せず、逆に土日を削除とか絶対しない前提なら、先頭は値を探すとして、末尾は月の休日数を足して求めてしまう事もできそう。祝日リストを用意していないなら、mmさんの方法の方が手堅いです。

参考までに、祝日は無視した数式の例なぞ。祝日対応するなら、祝日リスト（セル範囲か名前定義）をNETWORKDAYS.INTLの第4引数に指定してください。

 C1 =MATCH(B1,マスタ!A:A,0)
 D1 =C1+DAY(EOMONTH(B1,0))-NETWORKDAYS.INTL(B1,EOMONTH(B1,0),1)-1

WorkSheetFunctionを使えば、VBAでも書けます。

 Sub test()
    Dim i1 As Long
    Dim i2 As Long
    Dim dw As Date

    i1 = Application.WorksheetFunction.Match(Range("B1"), Sheets("マスタ").Range("A:A"), 0)
    dw = Application.EoMonth(Range("B1"), 0)
    i2 = i1 + Day(dw) - Application.WorksheetFunction.NetworkDays_Intl(Range("B1"), dw, 1) - 1

    MsgBox i1 & " - " & i2, vbInformation
 End Sub
（???） 2019/06/20(木) 15:55

隠居じーさん
mmさん
???さん

皆様ありがとうございました。
アドバイスいただいたことを組み込み下記の通りできました。

感謝申し上げます。解決です(^^)

Sub 未消化休の計算()

    Dim sh1 As Worksheet: Set sh1 = ActiveSheet
    Dim sh2 As Worksheet: Set sh2 = Worksheets("公休マスタ")
    Dim r As Long: r = sh1.Cells(Rows.Count, "B").End(xlUp).row + 1   '最終行

    '公休セル参照(マスタから処理月の最終公休日セルを取得)
    Dim c As Range, i As Long
    Dim Top_key As Date, Top_row As Long, myFand As Variant
    For i = 9 To r Step 2
        If IsDate(sh1.Cells(i, 51)) Then
            Top_key = sh1.Cells(i, 51)    '個人の最終公休日
            '公休リスト内に値があるか検索(*完全一致)
            Set myFand = sh2.Range("A2:A" & Rows.Count).SpecialCells(2).Find(Top_key, LookAt:=xlWhole)
            If myFand Is Nothing Then    '判定
                MsgBox sh1.Cells(i, 3) & vbCrLf & vbCrLf & " 公休日が一致しません" & vbCrLf & _
                       "入力値が「土日祝祭・社休」かを確認してください", vbOKOnly, "SKIP"
                sh1.Cells(i, 45).Value = "確認"
                GoTo SKIP1 '以降の処理を飛ばす
            Else
                '(個人最終公休セル行)
                Top_row = myFand.row

                '(処理月の最終公休セル行)
                Dim End_key As String, End_row As Long
                End_key = Format(sh1.Cells(2, 2), "yyyy/mm")    '処理月
                For Each c In sh2.Range("B2:B" & Rows.Count).SpecialCells(2)
                    '**_Keyが「リスト値一致」かつ「下のセルと年月が違う」→月が替わる=処理月の最終行である
                    If End_key = c.Value And End_key <> c.Offset(1, 0).Value Then End_row = c.row: Exit For
                Next c

                '(残休数の計算)
                Dim num As String
                '未消化の公休あり=行番号(公休)が処理月を越えていない場合
                If Top_row < End_row Then
                    num = End_row - Top_row
                Else    '前借りの公休あり=公休が処理月を越えた場合
                    num = 0    '残休なしでゼロ表示にする
                End If
                sh1.Cells(i, 45).Value = num
                'MsgBox "処理月 " & Format(sh2.Cells(End_row, 1), "yyyy/mm") & " 消化済み公休 " & sh2.Cells(Top_row, 1) & " 未消化の公休 " & num
            End If
        Else
            sh1.Cells(i, 45).Value = 0    ''休・産休・空欄・・・など日付以外の値の場合は飛ばす
        End If
        '公休日が一致しない場合はここに飛ぶ
SKIP1:
    Next i
    MsgBox "完了"
End Sub
（マイン） 2019/06/21(金) 07:29

コメント返信：

[ 一覧(最新更新順) ]

[[20190620091013]] 『(マクロ)リストから日付を参照しその範囲を求める』（マイン） ページの最後に飛ぶ

[[20190620091013]]　『(マクロ)リストから日付を参照しその範囲を求める』（マイン）　ページの最後に飛ぶ