[[20111130110337]]　『マクロのループ処理』（ちょこ）　ページの最後に飛ぶ

『マクロのループ処理』（ちょこ）

 表の中から今日の日付と一致したらメッセージボックスに表示するという
 マクロをつくっているのですが1つだけなら表示することが出来ました。
 しかし同じ日付は1つとは限らず複数ある場合もあります。
 そこでメッセージボックスに複数表示する為にループ処理をしたいのですが
 行き詰ってしまいました。
 このマクロにループ処理を組み込むにはどこにどんな構文？を入れたら良いのか
 教えて下さいませんか？

 Sub Sample5()

    Set FoundCell = Range("B:B").Find(What:=Format(Now(), "yyyy/mm/dd"),  LookIn:=xlValues)

        MsgBox "見つかりません"
    Else
        MsgBox FoundCell.Offset(0, 1)
    End If
 End Sub

 まず、アップされたコードで１つは検索できているとしたら、Ｂ列の日付というのが、どんな日付なのかな？
もし、通常の「日付型」データならマッチしないようにも思えるけど・・・・
なので、文字列型として 2011/11/30 といった形なんだろうね。

 ということを前提に。

 Sub Sample()
    Dim FoundCell As Range
    Dim First As Range

    Set FoundCell = Range("B:B").Find(What:=Format(Now(), "yyyy/mm/dd"), LookIn:=xlValues)
    If FoundCell Is Nothing Then
        MsgBox "見つかりません"
        Exit Sub
    End If
    Set First = FoundCell
    Do
        MsgBox FoundCell.Offset(0, 1)
        Set FoundCell = Range("B:B").FindNext(FoundCell)
    Loop While FoundCell.Address <> First.Address

    Set FoundCell = Nothing
    Set First = Nothing

 End Sub

 それと、テーマとは関係ないけど変数は必ず宣言しようね。

 (ぶらっと)

 ぶらっとさん、ありがとうございます。
 試したところばっちり動きました！
 あと、変数の件ですがループ文を模索中に間違って消してしまってたみたいです；
 あのあと動かなくて「え！？なんで！？」ってなりました；
 一応元のコードです。

 Sub Sample5()
    Dim FoundCell As Range
    Set FoundCell = Range("B:B").Find(What:=Format(Now(), "yyyy/mm/dd"), LookIn:=xlValues)
    If FoundCell Is Nothing Then
        MsgBox "見つかりません"
    Else
        MsgBox FoundCell.Offset(0, 1)
    End If
 End Sub

 あと、作ってもらっといて厚かましいのですが、
 このメッセージ、1つずつでなく1回で全て表示することは出来ますか？
 もしお時間あればよろしくお願いします。
 出来るだけ自分でもがんばってみます。（ちょこ）

 Sub Sample2()
    Dim FoundCell As Range
    Dim First As Range
    Dim v() As String
    Dim k As Long

    ReDim v(1 To Range("B" & Rows.Count).End(xlUp).Row)

    Set FoundCell = Range("B:B").Find(What:=Format(Now(), "yyyy/mm/dd"), LookIn:=xlValues)
    If FoundCell Is Nothing Then
        MsgBox "見つかりません"
        Exit Sub
    End If
    Set First = FoundCell
    Do
        k = k + 1
        v(k) = FoundCell.Row & "/" & FoundCell.Offset(0, 1).Value
        Set FoundCell = Range("B:B").FindNext(FoundCell)
    Loop While FoundCell.Address <> First.Address

    ReDim Preserve v(1 To k)
    MsgBox "以下の行に当日の日付がありました" & vbLf & Join(v, vbLf)

    Set FoundCell = Nothing
    Set First = Nothing

 End Sub

 (ぶらっと)

コメント返信：

[ 一覧(最新更新順) ]

[[20111130110337]] 『マクロのループ処理』（ちょこ） ページの最後に飛ぶ

[[20111130110337]]　『マクロのループ処理』（ちょこ）　ページの最後に飛ぶ