Spider-Makro zum Sammeln von Daten aus verschiedenen Dateien Excel

Beschreibung

In diesem Artikel betrachten wir ein Beispiel für ein Makro, das in vielen Arbeitsmappen nach Daten suchen und die ausgewählten Informationen in einer separaten Berichtsdatei aufzeichnen kann.

Öffnen Sie dazu Ihr Buch und gehen Sie zu Visual Basic Editor (Alt+F11) , Fügen Sie einen neuen Modulrohling hinzu (Insert - Module) und kopieren Sie diesen Makrotext dorthin:

Sub Report_file()
'moonexcel.com.ua
Application.ScreenUpdating = False ' Deaktivieren Sie die Bildschirmaktualisierung 

    Set report = Workbooks("Report.xlsb").Worksheets(1)
    find_field = report.[a1]
    
    ' Öffnen Sie den Dialog zur Auswahl der zu importierenden Dateien 
    FilesToOpen = Application.GetOpenFilename _
      (FileFilter:="All files (*.*), *.*", _
      MultiSelect:=True, Title:=" Dateien auswählen! ")

    If TypeName(FilesToOpen) = "Boolean" Then
        MsgBox " Keine Datei ausgewählt! "
        Exit Sub
    End If
    
    ' Wir gehen alle ausgewählten Dateien einzeln durch 
    m = 1
    While m <= UBound(FilesToOpen)
        Set importWB = Workbooks.Open(Filename:=FilesToOpen(m))
        Set importWS = importWB.Worksheets(1)
    
        ' Wir schlagen die Zellen“  Hüte  " 
        For Each cell2 In report.Range(report.Cells(1, 2), report.Cells(1, report.UsedRange.Columns.Count))
            On Error Resume Next: Err.Clear
            ' Suche nach Sinn in einem offenen Buch 
            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
            ' Übertragen Sie die gefundenen Werte in die Berichtsdatei 
            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

Danach können Sie zu Excel zurückkehren und unser Makro über das Menü ausführen Tools - Macro - Macros (Alt+F8) .