Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

29481 / 76732

←次へ　｜　前へ→


	【52532】Re:月間データ範囲取得について

Hirofumi - 07/11/17(土) 21:57 -


	引用なし

	パスワード

単純に上から月を見ていけば善いのでは？

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

0 hits

▼

【52530】月間データ範囲取得について yata 07/11/17(土) 20:30