Zeigt einen Wert aus der Zelle an, die neben einer Zelle liegt, die einen bereits gefundenen Wert enthält (A1, A2)

Question

Ich möchte meine Suche verbessern und ich möchtelZeile, Zelle 5um den Wert nach.Zellen(lRow, 4), welches istrGefunden.Wert.

Ich habe es mit FindNext versucht, aber es sucht nach einem bestimmtenSchnur.

Und dannReihe 6um den Wert anzuzeigen, der in der Zelle nachlZeile, Zelle 5und so weiter..

Mir gehen die Ideen aus. Gibt es einen einfachen Ausweg?

 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

Hier ist der gesamte Code:

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

Ich wäre für eure Hilfe sehr dankbar! :)

Answer 1

Um zur nächsten Zelle zu gelangen, können Sie OFFSETFolgendes verwenden:

rFound.Offset(1,0)