TOP

Macro Spider per raccogliere dati da vari file Excel

YouLibreCalc for Excel logo

Descrizione

In questo articolo prenderemo in considerazione un esempio di macro in grado di cercare dati in molte cartelle di lavoro e registrare le informazioni selezionate in un file di report separato.


Per fare questo, apri il tuo libro, vai a Visual Basic Editor (Alt+F11) , aggiungi un nuovo modulo vuoto (Insert - Module) e copia qui il testo della macro:

Sub Report_file()
'moonexcel.com.ua
Application.ScreenUpdating = False ' disabilitare l'aggiornamento dello schermo 

    Set report = Workbooks("Report.xlsb").Worksheets(1)
    find_field = report.[a1]
    
    ' aprire la finestra di dialogo per la selezione dei file da importare 
    FilesToOpen = Application.GetOpenFilename _
      (FileFilter:="All files (*.*), *.*", _
      MultiSelect:=True, Title:=" Seleziona i file! ")

    If TypeName(FilesToOpen) = "Boolean" Then
        MsgBox " Nessun file selezionato! "
        Exit Sub
    End If
    
    ' esaminiamo uno per uno tutti i file selezionati 
    m = 1
    While m <= UBound(FilesToOpen)
        Set importWB = Workbooks.Open(Filename:=FilesToOpen(m))
        Set importWS = importWB.Worksheets(1)
    
        ' battiamo le cellule"  cappelli  " 
        For Each cell2 In report.Range(report.Cells(1, 2), report.Cells(1, report.UsedRange.Columns.Count))
            On Error Resume Next: Err.Clear
            ' cercando un significato in un libro aperto 
            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
            ' trasferire i valori trovati nel file di report 
            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

Successivamente, puoi tornare a Excel ed eseguire la nostra macro tramite il menu Tools - Macro - Macros (Alt+F8) .