| |
Hirohumiさん、かみちゃんさん、Keinさん 有難うございました。
Hirohumiさんのコードを改造して二つのシートから４つの行位置を出すことが出来ました。
このコードをFunctionに直す方法はKeinさんの記事34482 「戻り値が複数のFanction」 を参考にしました。
また、Forのループの中で lngStart の値がどの様に変化してゆくかもよく分かり、大変勉強になりました。
下記コードで本ファイルに使わしてもらいます。
皆さん有難うございました。
Sub Kensaku()
Dim mySh As Worksheet
Dim firstR As Long, lastR As Long 'Sheet1の検索された行
Dim firstR2 As Long, lastR2 As Long 'Sheet2の検索された行
Dim i As Long
'Sheet1の上下2個の行を取得する
Set mySh = Sheets("Sheet1")
i = GetTwoRowsNum(mySh, firstR, lastR)
'Sheet2の上下2個の行を取得する
Set mySh = Sheets("Sheet2")
i = GetTwoRowsNum(mySh, firstR2, lastR2)
MsgBox "上側の行: " & firstR & "下側の行" & lastR & vbCrLf & _
"Sheet2の上の行は" & firstR2 & "下の行は" & lastR2
End Sub
Function GetFourRowNum(Sh As Worksheet, lngStart As Long, lngEnd As Long) As Long
Dim i As Long
Dim lngRows As Long 'Sheet1とSheet2の日付が入っている行数
Dim rngList As Range 'セルA1
Dim vntData As Variant '日付形式のデータ
Dim vntSearch As Variant '指定する月名
Dim strProm As String 'メッセージ
'◆Listの先頭セル位置を基準とする（A列の列見出しのセル位置=A1）
Set rngList = Sh.Cells(1, "A")
With rngList
'データの行数を取得
lngRows = Range("A" & Rows.Count).End(xlUp).Row - 1
If lngRows <= 0 Then
strProm = "データが有りません"
GoTo Wayout
End If
'列データを配列に取得 A2から最終セルの一つ下のセルまで
vntData = .Offset(1).Resize(lngRows + 1).Value
'テキストボックスの代わり
vntSearch = Sheets("Sheet1").Range("C1").Value
End With
'データの上から下につきを比べる
For i = 1 To lngRows + 1
'もし、先頭の行が未定で、探索月と同じ月なら
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
If i > lngRows Then
If lngStart > 0 Then
lngEnd = lngRows
End If
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 Function
|
|
yata
- 07/11/18(日) 21:25 -
