Warning: file_get_contents(/data/phpspider/zhask/data//catemap/5/excel/28.json): failed to open stream: No such file or directory in /data/phpspider/zhask/libs/function.php on line 167

Warning: Invalid argument supplied for foreach() in /data/phpspider/zhask/libs/tag.function.php on line 1116

Notice: Undefined index: in /data/phpspider/zhask/libs/function.php on line 180

Warning: array_chunk() expects parameter 1 to be array, null given in /data/phpspider/zhask/libs/function.php on line 181
Excel 在多个工作簿中查找字符串,然后查找其旁边单元格的值_Excel_Vba - Fatal编程技术网

Excel 在多个工作簿中查找字符串,然后查找其旁边单元格的值

Excel 在多个工作簿中查找字符串,然后查找其旁边单元格的值,excel,vba,Excel,Vba,我在网上找到了一个代码,可以搜索多个工作簿并找到某个字符串,然后打印它的地址、工作簿、工作表和值。但是,我需要代码来打印地址、工作簿、工作表及其旁边单元格的值 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

我在网上找到了一个代码,可以搜索多个工作簿并找到某个字符串,然后打印它的地址、工作簿、工作表和值。但是,我需要代码来打印地址、工作簿、工作表及其旁边单元格的值

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:\DondeSoftware\Vo Temp\Mock Portfolios\Feng Zheyuan\Portfolio Snapshots"
strSearch = "Cash:"

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

但我错了。是否有人帮助更改此代码?

若要查找该单元格的值,请使用
.Offset
例如,右边的一列,它将是
rFound.Offset(,1).value
如果需要地址,请使用
rFound.Offset(,1).address

如果要返回范围对象,请尝试以下操作

Dim cashcell as Range
Set cashcell = rFound.Offset(,1)

您可能还想查看

,因此我使用了
rFound.Offset(0,1).Value
,它起了作用。谢谢大家的帮助

您想知道rFound range旁边单元格的详细信息吗?我只想找到值。但我需要rFound本身的详细信息。补偿完全有效。谢谢
Dim cashcell as Range
Set cashcell = rFound.Offset(,1)