|
単純に上から月を見ていけば善いのでは?
Option Explicit
Public Sub Sample()
Dim i As Long
Dim lngRows As Long
Dim rngList As Range
Dim vntData As Variant
Dim vntSearch As Variant
Dim lngStart As Long
Dim lngEnd As Long
Dim strProm As String
'◆Listの先頭セル位置を基準とする(A列の列見出しのセル位置)
Set rngList = Worksheets("Sheet1").Cells(1, "A")
With rngList
'行数の取得
lngRows = .Offset(Rows.Count - .Row).End(xlUp).Row - .Row
If lngRows <= 0 Then
strProm = "データが有りません"
GoTo Wayout
End If
'列データを配列に取得
vntData = .Offset(1).Resize(lngRows + 1).Value
'テキストボックスの代わり
vntSearch = .Parent.Range("C1").Value
End With
'データの上から下につきを比べる
For i = 1 To lngRows
'もし、先頭の行が未定で、探索月と同じ月なら
If lngStart = 0 And Month(vntData(i, 1)) = vntSearch Then
lngStart = i
End If
'もし、先頭の行が決定されていて、探索月と違う月なら
If lngStart > 0 And Month(vntData(i, 1)) <> vntSearch Then
lngEnd = i - 1
Exit For
End If
Next i
If lngStart = 0 Then
strProm = "目的の" & vntSearch & "月のデータが有りません"
Else
strProm = "処理が完了しました" & vbLf _
& "上側の行: " & (rngList.Row + lngStart) & vbLf _
& "下側の行: " & (rngList.Row + lngEnd)
End If
Wayout:
Set rngList = Nothing
MsgBox strProm, vbInformation
End Sub
|
|