Excel VBA質問箱 IV

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

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


29487 / 76738 ←次へ | 前へ→

【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 質問
【52531】Re:月間データ範囲取得について かみちゃん 07/11/17(土) 21:17 発言
【52533】Re:月間データ範囲取得について yata 07/11/17(土) 22:01 質問
【52534】Re:月間データ範囲取得について かみちゃん 07/11/17(土) 22:17 発言
【52542】Re:月間データ範囲取得について yata 07/11/17(土) 23:49 お礼
【52532】Re:月間データ範囲取得について Hirofumi 07/11/17(土) 21:57 回答
【52535】Re:月間データ範囲取得について yata 07/11/17(土) 22:18 お礼
【52538】Re:月間データ範囲取得について Hirofumi 07/11/17(土) 23:07 回答
【52540】Re:月間データ範囲取得について Hirofumi 07/11/17(土) 23:26 回答
【52541】Re:月間データ範囲取得について yata 07/11/17(土) 23:37 お礼
【52548】結果報告とお礼 yata 07/11/18(日) 21:25 お礼

29487 / 76738 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free