メッセージボックス内の予定の表示方法について

質問

Excel 2007を使っており、メッセージボックスに今日の予定をVBAで表示させたいのですが、うまくできませんのでよろしくお願いします。
以下の内容となります。

1.シート1のＡ列に日付が入力されています。
2.シート1のＢ列に予定が入力されています。
3.毎日処理するエクセルファイルがあるため、そのファイルを開くと今日の予定をメッセージボックス　で表示。
4.今日の予定がない場合は、本日の予定なしを表示。
5.複数の予定がある場合は、順番にメッセージボックスで表示。

以下のものを作りましたが、同じ日付が２つ以上あると一番上のものしか表示されません。
今日の日付がシート1にないとエラーになります。

Sub yotei()
Dim RG As Range
Dim ms As String
ms = ActiveCell.Value
For Each RG In Range("A:A")
If RG = Date Then Exit For
Next RG
RG.Select
ActiveCell.Offset(, 1).Select
MsgBox RG
MsgBox ActiveCell.Value
End Sub

回答No.1

o_chi_chi · ベストアンサー

＞一番上のものしか表示されません

If RG = Date Then Exit For

日付が見つかった時点で終了しています。

＞シート1にないとエラーになります。

RGが見つからないときの処理が抜けています。

方法はいろいろあるかと思いますが、Findを使って検索します。

また順番にメッセージボックスとのことですが、

処理が煩雑になりそうなので同時出力としました。

（複数検索ロジックは変わらないので理解できれば

順番に出力もすぐできると思います。）

----
Sub yotei()
Dim rngFound As Range
Dim rngFirst As Range
Dim strMsg As String

Set rngFound = Worksheets("Sheet1").Cells.Find(What:=Date)

If rngFound Is Nothing Then
MsgBox "本日の予定なし"
Exit Sub
Else
'最初のセルを保存
Set rngFirst = rngFound
strMsg = rngFound.Offset(, 1).Value
End If
Do
Set rngFound = Worksheets("Sheet1").Cells.FindNext(rngFound)
If rngFound.Address = rngFirst.Address Then
'最初に見つかったセルと同じ時終了
Exit Do
Else
strMsg = strMsg & vbCrLf & rngFound.Offset(, 1).Value
End If
Loop
MsgBox strMsg
End Sub

お礼

ありがとうございました。
正常に動作して、とても助かりました。
今後とも、よろしくお願いします。

回答No.2

TAKA_R

こんな感じでしょうか（動作確認していません）
ちょっと１段目が下がってしまいますけどね。

Sub yotei()
Dim RG As Range
Dim ms As String
For Each RG In Range("A:A")
If RG.Value = Date Then
ms=ms & vbCrLf &RG.Offset(, 1).Value
Next RG
if not ms="" then
MsgBox ms
else
MsgBox "本日の予定なし"
end if
End Sub

お礼

ありがとうございます。
動作させたところ、”NEXTに対するForがありません”のエラーが出て
動きませんでした。
エラーとなったことについて、自分で考えて、勉強したいと思います。
今後とも、よろしくお願いします。