用于从各种文件收集数据的Spider宏Excel

描述

在本文中，我们将考虑一个宏示例，该宏可以在许多工作簿中搜索数据并将所选信息记录在单独的报告文件中。

为此，请打开您的书本，转至 Visual Basic Editor (Alt+F11) , 添加新模块空白 (Insert - Module ）并将此宏文本复制到此处：

Sub Report_file()
'moonexcel.com.ua
Application.ScreenUpdating = False ' 禁用屏幕刷新 

    Set report = Workbooks("Report.xlsb").Worksheets(1)
    find_field = report.[a1]
    
    ' 打开用于选择要导入的文件的对话框 
    FilesToOpen = Application.GetOpenFilename _
      (FileFilter:="All files (*.*), *.*", _
      MultiSelect:=True, Title:=" 选择文件！ ")

    If TypeName(FilesToOpen) = "Boolean" Then
        MsgBox " 未选择文件！ "
        Exit Sub
    End If
    
    ' 我们一一浏览所有选定的文件 
    m = 1
    While m <= UBound(FilesToOpen)
        Set importWB = Workbooks.Open(Filename:=FilesToOpen(m))
        Set importWS = importWB.Worksheets(1)
    
        ' 我们打败了细胞”  帽子  ” 
        For Each cell2 In report.Range(report.Cells(1, 2), report.Cells(1, report.UsedRange.Columns.Count))
            On Error Resume Next: Err.Clear
            ' 在一本打开的书中寻找意义 
            tr = importWS.UsedRange.Find(find_field).Row
            tc = importWS.UsedRange.Find(find_field).Column
            x = importWS.Range(importWS.Cells(tr, tc), importWS.Cells(20000, tc)).Find(report.Cells(m + 1, 1).Value).Row
            y = importWS.UsedRange.Find(cell2.Value).Column
            ' 将找到的值传输到报告文件 
            report.Cells(m + 1, cell2.Column).Value = importWS.Cells(x, y).Value
        Next
        
        importWB.Close savechanges:=False
        m = m + 1
    Wend
         
Application.ScreenUpdating = True
End Sub

之后，您可以返回Excel并通过菜单运行我们的宏 Tools - Macro - Macros (Alt+F8) 。