Поиск строки в нескольких книгах, а затем поиск значения ячейки рядом с ней - PullRequest
0 голосов
/ 08 января 2019

Я нашел в Интернете код для поиска по нескольким рабочим книгам и поиска определенной строки, а затем распечатал ее адрес, рабочую книгу, рабочий лист и значение. Однако мне нужен код, чтобы напечатать мне адрес, рабочую книгу, рабочий лист и значение ячейки рядом с ним.

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 голосов
/ 08 января 2019

Итак, я использовал rFound.Offset(0,1).Value, и это сработало. Всем спасибо за помощь!

0 голосов
/ 08 января 2019

Чтобы найти значение этой ячейки, используйте .Offset Например, один столбец справа, это будет rFound.Offset(,1).Value А если вы хотите адрес, то rFound.Offset(,1).Address

Если вы хотите вернуть объект диапазона, попробуйте это

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

Вы также можете захотеть увидеть Свойство Range.Offset (Excel)

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...