Vba 搜索特定数据，并将其复制到当前文档

我创建了一个宏，在Excel电子表格的第一列中列出了需要从中获取数据的所有文件。是否可以搜索列中的每个文件，并使用关键字查找特定数据。例如，我的主控文档的第一列是：

file1
file2
file3

---

我想搜索文件1，然后搜索文件2。。。对于关键字“alpha”“beta”“gamma”，然后将这些单元格下面的数字复制到主文档中的表中。这可能吗？如果可能，我应该走哪条路？

这是可能的。只需使用工作簿。按此处所述打开： 作为文件名，只需传递保存所述文件名的单元格值

非常基本的示例：假设工作表（1）上的单元格A1包含要打开的文件的文件路径+文件名

Sub OpenFile()
Dim wb as WorkBook
Dim fRange as range

Set wb = Application.Workbooks.Open(Worksheets(1).Range("A1").value)
With wb
    set fRange = .Sheets(1).Range("1:1").find("Alpha") 'Assuming Alpha is a header in row 1
    'Do stuff with the cells below the found range
End With

Set fRange = Nothing
Set wb = Nothing
End Sub

---

您可能希望将ActiveWorkbook/ActiveSheet/对母版的任何引用也存储在一个变量中，以确保可以将粘贴从正确的位置复制到正确的位置。

好吧，我想给出另一个答案，但是，@RickSportel给出了一个非常好的建议

希望这会有所帮助

Sub findDataIntoFiles()

    Dim r
    Dim findValues() As String 'heres goes all the values you want to search
    Dim Wrbk As Workbook 'to store every workbook
    Dim This As Workbook 'to store this workbook, where you got the macro
    Dim sht As Worksheet 'to store every sheet of the workbooks
    Dim i
    Dim tmp
    Dim counter
    Dim c As Range
    Dim firstAddress
    Dim rng As Range 'the range with the files full path of the file names
                     'Not just the names
                     'or
                     'if all the files are in the same folder, you can put the path
                     'on a var, and concatenate the path with each file name

    ReDim findValues(1 To 3) 'here redim the var, but you can declare it with the capacity you want
    findValues(1) = "Alpha"
    findValues(2) = "Beta"
    findValues(3) = "Gamma"
    counter = 0

    r = Range("A1").End(xlDown).Row 'to search the last row of the data with the workbooks names
    Set rng = Range(Cells(1, 1), Cells(r, 1)) 'all the data is in column A
    Set This = ThisWorkbook 'storing this workbook

    For Each tmp In rng 'run this for every cell with the workbooks names
        Workbooks.Open tmp 'the open the workbook
        Set Wrbk = ActiveWorkbook 'store it ot use it
        For Each sht In Wrbk.Worksheets 'here, for every sheet inside the workbook that i opened
            For i = 1 To 3 'the qty of data inside findValues var'for every data inside the var
                With sht.Range(Cells(1, 1), Range("A1").SpecialCells(xlCellTypeLastCell))
                'find inside the cells A1 and the LastCell of the sheet
                Set c = .Find(findvalue(i), LookIn:=xlFormulas) 'you can chage ir to "xlValues"
                    If Not c Is Nothing Then
                        firstAddress = c.Address
                        Do
                            'This.Activate'go back to the macro workbook and store the data found
                            tmp.Offset(0, 1).Value = tmp.Value 'the name/fullpath/path of the workbook
                            tmp.Offset(0, 2).Value = sht.Name & "\" & c.Address 'Sheet and address of the cell
                            Set c = .FindNext(c) 'go to the next one
                            counter = counter + 1 'and index for the columns where you will store the data
                        Loop While Not c Is Nothing And c.Address <> firstAddress
                    End If
                End With
            Next
        Next sht
    Next tmp
End Sub

---

嗨，埃尔伯特，非常感谢你的帮助！关于代码的一个问题，我了解其中的大部分内容，但我想知道在哪里修改相对于关键字的单元格。假设我找到了alpha，但想把2个单元格移到右边？简而言之，每个关键字都可能有不同的条件吗？如您所见，

c.Address

返回包含

“alpha

字符串的单元格地址。如果使用

c.offset（行数，列数）

你可以得到你想要的单元格。啊，非常感谢！：）你是如何变得如此精通vba的？嗨，Elbert，很抱歉提出一个老话题，但我还有一个问题，关于如何调整你的代码以改变输出。是否可以为FindValue中不同的“i”值指定不同的输出位置（i） ？例如，对于“alpha”，输出在C列，但对于Bravo，输出在D列？我尝试了一些方法，但没有成功，因为目标位置在循环中？

c.Address ===> Gives you the address (string) of the found cell ex. $G$4
c.offset(2,2).address ===> gives you the cell moving two rows and two columns from `c` and returns $I$6. If you put negative numbers you rest rows and columns.