[[20230315154344]]　『検索して複数該当したものをまとめて表示したい』（マクロ初心者）　ページの最後に飛ぶ

『検索して複数該当したものをまとめて表示したい』（マクロ初心者）

インプットボックスで照会番号を記入してもらい、その番号を検索して100日以上経過していたら「有効期限切れ」100日以内なら経過日を表示されるようにしているのですが、該当するセルが複数あるときにメッセージボックスにて
・有効期限切れと有効期限内両方該当
管理番号：●●　有効期限切れ
管理番号：△△
取得日から〇〇日経過
管理番号：□□
取得日から〇〇日経過

というようにまとめて表示したいです
調べてFINDNEXT関数を使うとありましたが条件式との組み合わせが分からず教えていただきたいです。

　A列　　：～：　AD列　： AE列
管理番号：～：紹介番号：取得日

Sub 照会番号検索()

    Dim Find_Data As Range
    Dim Find_Name As String
    Dim 取得日 As Variant

    Find_Name = Application.InputBox("照会番号を記入してください", "照会番号検索", Type:=1)

   Set Find_Data = ThisWorkbook.Sheets(2).Range("AD:AD").Find(What:=StrConv(Find_Name, vbNarrow), lookat:=xlWhole)

    Select Case Find_Name
           Case False
           Case ""
           Case Else
        If Find_Data Is Nothing Then
            MsgBox "見つかりません"
        ElseIf DateDiff("d", Find_Data.Next, Date) > 100 Then
            MsgBox "管理番号：" & Sheets(2).Cells(Find_Data.Row, "A").Value & "　有効期限切れです"
        Else
            MsgBox "管理番号：" & Sheets(2).Cells(Find_Data.Row, "A").Value & vbCrLf & _
            "取得日から" & DateDiff("d", Find_Data.Next, Date) & "日経過"

        End If
    End Select

End Sub

＜使用 Excel：Excel2016、使用 OS：Windows10 ＞

FindNext 参考
https://excel-ubara.com/excelvba1/EXCELVBA398.html

 提示のコードが書けるなら、↑見れば分かると思いますよ。
（tkit） 2023/03/15(水) 16:25:06

下記コードでしたいことはできたのですが、キャンセルしたとき、見つかりませんの時、有効期限切れの時にエラーコード９１がでてしまいます。

Sub 照会番号検索()

    Dim Find_Data As Range, myRange As Range
    Dim Find_Name As String
    Dim 取得日 As Variant

    Find_Name = Application.InputBox("照会番号を記入してください", "照会番号検索", Type:=1)

    Set myRange = ThisWorkbook.Sheets(2).Range("AD:AD")
    Set Find_Data = myRange.Find(What:=StrConv(Find_Name, vbNarrow), lookat:=xlWhole)

    Select Case Find_Name
           Case False
           Case ""
           Case Else
        If Find_Data Is Nothing Then
            MsgBox "見つかりません"
        ElseIf DateDiff("d", Find_Data.Next, Date) > 100 Then
            MsgBox "有効期限切れです"
            Exit Sub
        End If
    End Select

    Dim msg As String
    Dim myCell As Range
    Set myCell = Find_Data
        Do
            msg = msg & Sheets(2).Cells(myCell.Row, "A").Value & vbCrLf
               Set myCell = myRange.FindNext(myCell)
        Loop While myCell.Row <> Find_Data.Row

        MsgBox "取得日から" & DateDiff("d", Find_Data.Next, Date) & "日経過" & vbCrLf & _
                "管理番号" & vbCrLf & _
                 msg

End Sub

（マクロ初心者） 2023/03/15(水) 17:15:45

既に解決しているから放置しているだけかもしれませんが一応。

■１
＞キャンセルしたとき、見つかりませんの時、有効期限切れの時にエラーコード９１がでてしまいます。
真面目にインデントを付けなおしてステップ実行してみてはどうでしょうか？

    Sub 照会番号検索()
        Dim Find_Data As Range, myRange As Range
        Dim Find_Name As String
        Dim 取得日 As Variant

        Find_Name = Application.InputBox("照会番号を記入してください", "照会番号検索", Type:=1)
        Set myRange = ThisWorkbook.Sheets(2).Range("AD:AD")
        Set Find_Data = myRange.Find(What:=StrConv(Find_Name, vbNarrow), lookat:=xlWhole)

        Select Case Find_Name
            Case False
                Stop
                '何もせず★のところまで進む
            Case ""
                Stop
                '何もせず★のところまで進む
            Case Else
                If Find_Data Is Nothing Then
                    MsgBox "見つかりません"
                    '↑を表示したら★のところまで進む
                ElseIf DateDiff("d", Find_Data.Next, Date) > 100 Then
                    MsgBox "有効期限切れです"
                    Exit Sub
                End If
        End Select

        '★ここに飛ぶ
        Stop

        Dim msg As String
        Dim myCell As Range
        Set myCell = Find_Data

        Do
            msg = msg & Sheets(2).Cells(myCell.Row, "A").Value & vbCrLf
            Set myCell = myRange.FindNext(myCell)
        Loop While myCell.Row <> Find_Data.Row

        MsgBox "取得日から" & DateDiff("d", Find_Data.Next, Date) & "日経過" & vbCrLf & "管理番号" & vbCrLf & msg
    End Sub

すなわち↑のように整理すればわかると思いますが、進むべきでないときまで★のところに進んでしまうのが問題でしょう。

■２
質問とは関係しませんが↓の部分について

 Find_Name = Application.InputBox("照会番号を記入してください", "照会番号検索", Type:=1)
 Select Case Find_Name
     Case ""

「Find_Nam」が""になることは無いと思います。

■３
おなじく質問と関連しませんし、Excel君の忖度で問題はでないのでしょうが以下の部分について

 Dim Find_Name As String
 Find_Name = Application.InputBox("照会番号を記入してください", "照会番号検索", Type:=1)

InputBoxをキャンセルしたときの【Find_Name】はFalse(論理値)ではなく、"False"（文字列）です。

■４
ということを踏まえると、例えば↓のように修正するとよいと思います。

    Sub 照会番号検索_修正()
        Dim Find_Data As Range, myRange As Range
        Dim Find_Name As String
        Dim 取得日 As Variant
        Dim msg As String
        Dim myCell As Range

        Set myRange = ThisWorkbook.Sheets(2).Range("AD:AD")

        Find_Name = Application.InputBox("照会番号を記入してください", "照会番号検索", Type:=1)
        If Find_Name = "False" Then
            msg = "処理をキャンセルしました"
        Else
            Set Find_Data = myRange.Find(What:=StrConv(Find_Name, vbNarrow), lookat:=xlWhole)
            If Find_Data Is Nothing Then
                msg = "見つかりません"
            Else
                If DateDiff("d", Find_Data.Next, Date) > 100 Then
                    msg = "有効期限切れです"
                End If
            End If
        End If

        If msg <> "" Then
            MsgBox msg
            Exit Sub
        Else
            msg = "" 'ここで「msg」を初期化
            Set myCell = Find_Data
            Do
                msg = msg & Sheets(2).Cells(myCell.Row, "A").Value & vbCrLf
                Set myCell = myRange.FindNext(myCell)
            Loop While myCell.Row <> Find_Data.Row

            MsgBox "取得日から" & DateDiff("d", Find_Data.Next, Date) & "日経過" & vbCrLf & "管理番号" & vbCrLf & msg
        End If
    End Sub

（もこな２） 2023/03/18(土) 06:57:21

コメント返信：

[ 一覧(最新更新順) ]

[[20230315154344]] 『検索して複数該当したものをまとめて表示したい』（マクロ初心者） ページの最後に飛ぶ

[[20230315154344]]　『検索して複数該当したものをまとめて表示したい』（マクロ初心者）　ページの最後に飛ぶ