Показать значение из ячейки, которая находится рядом с ячейкой, содержащей уже найденное значение (A1, A2)

Question

Я хочу улучшить свой поиск и хочуlСтрока, ячейка 5чтобы показать значение после.Ячейки(lRow, 4), которыйrFound.Значение.

Я пробовал использовать FindNext, но он ищет определенныйнить.

А потомlРяд, 6чтобы показать значение, которое находится в ячейке послеlСтрока, ячейка 5и так далее..

У меня нет идей. Есть ли какой-нибудь простой выход?

 Else
            lRow = lRow + 1
            .Cells(lRow, 1) = wbk.Name
            .Cells(lRow, 2) = wks.Name
            .Cells(lRow, 3) = rFound.Address
            .Cells(lRow, 4) = rFound.Value
            '.Cells(lRow, 5) = rFound.FindNext(rFound.Value) //this is so wrong!
            '.Cells(lRow, 6) = wbk.Name
            '.Cells(lRow, 7) = wbk.Name
            '.Cells(lRow, 8) = wbk.Name

Вот весь код:

Sub SearchFolder()
    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
    Application.Calculation = xlCalculationManual 'added by me

    'Change as desired
    'strPath = "T:\Rali\Excel\Test"
    'strSearch = "hey"
    
    strPath = ActiveSheet.Range("C10")
    strSearch = ActiveSheet.Range("E10")

    Set wOut = Worksheets.Add
    lRow = 1
    With wOut
        .Cells(lRow, 1) = "Workbook's Name"
        .Cells(lRow, 2) = "Worksheet's Name"
        .Cells(lRow, 3) = "Cell Address"
        .Cells(lRow, 4) = "Single - Label"
        .Cells(lRow, 5) = "Short Name"
        .Cells(lRow, 6) = "Last Name"
        .Cells(lRow, 7) = "First Name"
        .Cells(lRow, 8) = "E-Mail"
        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
                       '.Cells(lRow, 5) = rFound.FindNext(rFound.Value)
                       '.Cells(lRow, 6) = wbk.Name
                       '.Cells(lRow, 7) = wbk.Name
                       '.Cells(lRow, 8) = wbk.Name
                    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
 If lRow > 1 Then 'added by me
    MsgBox "Done"
Else
    MsgBox "Nothing found! You are one step closer to approving this credit limit request :)"
End If

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

Буду очень признателен за вашу помощь! :)

Answer 1

Чтобы перейти к следующей ячейке, можно использовать OFFSET, например:

rFound.Offset(1,0)