검색 항목을 찾을 수 없는 경우 나타나는 메시지 상자

검색 항목을 찾을 수 없는 경우 나타나는 메시지 상자

검색이 완료되면 팝업 창이 표시됩니다.팝업창 완료

완료를 클릭하면 결과가 포함된 새 시트가 열립니다.

결과 시트

아무 것도 발견되지 않은 경우 "아무것도 찾을 수 없습니다"라는 텍스트가 팝업 창에 표시되기를 원합니다.

저 좀 도와 주 시겠어요?

전체 코드는 다음과 같습니다.

Sub SearchFolders()
    Dim fso As Object
    Dim fld As Object
    Dim strSearch As String
    Dim strPath As String
    Dim strFile As String
    Dim wOut As Worksheet
    Dim wbk As Workbook
    Dim wks As Worksheet
    Dim lRow As Long
    Dim rFound As Range
    Dim strFirstAddress As String

    On Error GoTo ErrHandler
    Application.ScreenUpdating = False

    'Change as desired
    strPath = "c:\MyFolder"
    strSearch = "Specific text"

    Set wOut = Worksheets.Add
    lRow = 1
    With wOut
        .Cells(lRow, 1) = "Workbook"
        .Cells(lRow, 2) = "Worksheet"
        .Cells(lRow, 3) = "Cell"
        .Cells(lRow, 4) = "Text in Cell"
        Set fso = CreateObject("Scripting.FileSystemObject")
        Set fld = fso.GetFolder(strPath)

        strFile = Dir(strPath & "\*.xls*")
        Do While strFile <> ""
            Set wbk = Workbooks.Open _
              (Filename:=strPath & "\" & strFile, _
              UpdateLinks:=0, _
              ReadOnly:=True, _
              AddToMRU:=False)

            For Each wks In wbk.Worksheets
                Set rFound = wks.UsedRange.Find(strSearch)
                If Not rFound Is Nothing Then
                    strFirstAddress = rFound.Address
                End If
                Do
                    If rFound Is Nothing Then
                        Exit Do
                    Else
                        lRow = lRow + 1
                        .Cells(lRow, 1) = wbk.Name
                        .Cells(lRow, 2) = wks.Name
                        .Cells(lRow, 3) = rFound.Address
                        .Cells(lRow, 4) = rFound.Value
                    End If
                    Set rFound = wks.Cells.FindNext(After:=rFound)
                Loop While strFirstAddress <> rFound.Address
            Next

            wbk.Close (False)
            strFile = Dir
        Loop
        .Columns("A:D").EntireColumn.AutoFit
    End With
    MsgBox "Done"

ExitHandler:
    Set wOut = Nothing
    Set wks = Nothing
    Set wbk = Nothing
    Set fld = Nothing
    Set fso = Nothing
    Application.ScreenUpdating = True
    Exit Sub

ErrHandler:
    MsgBox Err.Description, vbExclamation
    Resume ExitHandler
End Sub

답변1

카운터가 lrow0보다 큰지 테스트할 수 있습니다. 그렇다면 이는 무언가가 발견되었음을 의미합니다. 그렇지 않다면 아무것도 발견되지 않은 것입니다. 작성한 코드 부분을 변경하십시오 MsgBox "Done".

If lrow > 0 Then
    MsgBox "Done"
Else
    MsgBox "Nothing found"
End If

관련 정보