Блог

У меня есть 400 файлов Excel (технические отчеты), каждый из которых содержит 5 вкладок с разными именами. Мне нужно создать основную электронную таблицу с определенной информацией о каждом из этих отчетов (информация всегда на одной вкладке)

У меня есть код (скопированный отсюда), который можно использовать для поиска информации в определенной ячейке.

Проблема в том, что структура отчетов не согласована, хорошей новостью является то, что в соседней ячейке с информацией, которую я ищу, всегда есть один и тот же текст «Уровень воды:».

Мне нужен макрос, который может выполнять поиск по этой текстовой строке, копировать соседнюю ячейку и возвращать ее в эту основную таблицу.

Пожалуйста, посмотрите код, который я упомянул:

   Sub Test()
' Adjust the path below as required
MyPath = "C:Usersbcf00637DesktoppilelogsV2"    ' Set the path.
myname = Dir(MyPath, vbNormal)    ' Retrieve the first entry.
Do While myname <> ""    ' Start the loop.
    ' Ignore the current directory and the encompassing directory.
    If myname <> "." And myname <> ".." Then
        If (GetAttr(MyPath amp; myname) And vbNormal) = vbNormal Then
           ActiveCell.FormulaR1C1 = "='" amp; MyPath amp; "[" amp; myname amp; "]Approval Form'!R1C1" ' change the part after the ] to your sheets name
           ' also change the R1C1 on the end to pick up the cell you want ie R2C3 for cell C2
           ' do NOT change the 1st one (.FormulaR1C1) this is part of the command.
           ActiveCell.Offset(0, 1).Value = myname
           ActiveCell.Offset(1, 0).Select
        End If
    End If
    myname = Dir
Loop

End Sub
  

Попробуйте это. Несколько запросов в комментариях, поскольку детали вашего вопроса неясны.

 Sub Test()

Dim r As Range, wb As Workbook

mypath = "C:Usersbcf00637DesktoppilelogsV2"
myname = Dir(mypath, vbNormal)

Do While myname <> ""
    If myname <> "." And myname <> ".." Then
        Set wb = Workbooks.Open(Filename:=mypath amp; myname)
        If (GetAttr(mypath amp; myname) And vbNormal) = vbNormal Then
            'have left this line as not sure what it does
            ActiveCell.FormulaR1C1 = "='" amp; mypath amp; "[" amp; myname amp; "]Approval Form'!R1C1"
            'change sheet name to suit
            Set r = wb.Sheets("Sheet1").usedrange.Find(what:="Water level:", lookat:=xlWhole,matchcase:=false)
            If Not r Is Nothing Then
                'puts cell to the right in column A of master sheet
                ThisWorkbook.Sheets(1).Range("A" amp; Rows.Count).End.xlUp(2).Value = r.Offset(1).Value
            End If
        End If
        wb.Close False
    End If
    myname = Dir
Loop

End Sub