循环遍历多个excel文件，查找字符串，并返回相邻单元格中的值

Question

我有 400 个 excel 文件（技术报告），每个文件都有 5 个不同名称的选项卡。我需要创建一个主电子表格，其中包含每个报告的某些信息（信息始终在同一个选项卡上）

我有一个代码（从此处复制），可用于在特定单元格中查找信息。

问题是报告的结构不一致，好消息是在我搜索的信息的相邻单元格上，总是有相同的文本“水位：”。

我正在寻找一个可以搜索此文本字符串、复制相邻单元格并将其返回到此主电子表格的宏。

请看我提到的代码：

  Sub Test()
' Adjust the path below as required
MyPath = "C:\Users\bcf00637\Desktop\pilelogs\V2\"    ' 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 & myname) And vbNormal) = vbNormal Then
           ActiveCell.FormulaR1C1 = "='" & MyPath & "[" & myname & "]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

Answer 1

试试这个。由于您的问题的详细信息不清楚，因此在 cmets 中进行了一些查询。

Sub Test()

Dim r As Range, wb As Workbook

mypath = "C:\Users\bcf00637\Desktop\pilelogs\V2\"
myname = Dir(mypath, vbNormal)

Do While myname <> ""
    If myname <> "." And myname <> ".." Then
        Set wb = Workbooks.Open(Filename:=mypath & myname)
        If (GetAttr(mypath & myname) And vbNormal) = vbNormal Then
            'have left this line as not sure what it does
            ActiveCell.FormulaR1C1 = "='" & mypath & "[" & myname & "]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" & Rows.Count).End.xlUp(2).Value = r.Offset(1).Value
            End If
        End If
        wb.Close False
    End If
    myname = Dir
Loop

End Sub