Question

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

file1
file2
file3

我想搜索file1然后file2 ...搜索关键字＆＃34; alpha＆＃34; ＆＃34;测试＆＃34; ＆＃34;伽马＆＃34;然后将这些单元格下面的数字复制到主文档中的表格中。这是可能的，如果可以的话，我应该走哪条路？

Answer 1

好吧，我想再给出一个答案，但@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

这是基本的，你需要使用工作簿名称迭代单元格，如果有完整路径只是采取它，但如果不采取文件所在的路径（目录），然后连接并打开工作簿Workbook.Open

浏览每个worbook的每一张，找到你想要的数据。

编辑＃1 正如您在评论中提到的那样，这可以为您提供下一个找到搜索字符串的单元格

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.

Answer 2

这是可能的。只需使用Workbooks.Open，如下所示： https://msdn.microsoft.com/en-us/library/office/ff194819.aspx 作为文件名，只需传递包含所述文件名的单元格值。

非常基本的示例：假设工作表（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 / Any引用存储在变量中，以确保您可以从正确的位置复制粘贴到正确的位置。

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

2 个答案: