在多个工作簿中找到一个字符串,然后找到它旁边的单元格的值

时间:2019-01-08 07:24:00

标签: 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 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

我认为我可以像这样做一样添加变量

Dim cashcell as Range
cashcell = Range(rFound.Row, rFound.Column + 1)

但是我错了。有人帮忙修改此代码吗?

2 个答案:

答案 0 :(得分:2)

要查找该单元格的值,请使用.Offset,例如,右边的一列将是rFound.Offset(,1).Value,如果您需要地址,则rFound.Offset(,1).Address

如果您想返回范围对象,请尝试

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

您可能还希望看到Range.Offset property (Excel)

答案 1 :(得分:0)

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