☰

显示包含已找到值的单元格旁边的单元格中的值（A1，A2）

tag-icon • tag-icon microsoft-excel vba search
显示包含已找到值的单元格旁边的单元格中的值（A1，A2）

我想升级我的搜索，我想要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

我将十分感激您的帮助！:)

答案1

要移动到下一个单元格，您可以使用OFFSET，例如：

rFound.Offset(1,0)

相关内容