TOP

Macro-paianjen pentru colectarea datelor din diferite fișiere Excel

YouLibreCalc for Excel logo

Descriere

În acest articol, vom lua în considerare un exemplu de macrocomandă care poate căuta date în multe registre de lucru și poate înregistra informațiile selectate într-un fișier de raport separat.


Pentru a face acest lucru, deschideți cartea, accesați Visual Basic Editor (Alt+F11) , adăugați un nou gol de modul (Insert - Module) și copiați acest text macro acolo:

Sub Report_file()
'moonexcel.com.ua
Application.ScreenUpdating = False ' dezactivați reîmprospătarea ecranului 

    Set report = Workbooks("Report.xlsb").Worksheets(1)
    find_field = report.[a1]
    
    ' deschide caseta de dialog pentru selectarea fișierelor pentru import 
    FilesToOpen = Application.GetOpenFilename _
      (FileFilter:="All files (*.*), *.*", _
      MultiSelect:=True, Title:=" Selectati fisierele! ")

    If TypeName(FilesToOpen) = "Boolean" Then
        MsgBox " Niciun fisier selectat! "
        Exit Sub
    End If
    
    ' parcurgem toate fișierele selectate unul câte unul 
    m = 1
    While m <= UBound(FilesToOpen)
        Set importWB = Workbooks.Open(Filename:=FilesToOpen(m))
        Set importWS = importWB.Worksheets(1)
    
        ' batem celulele"  palării  " 
        For Each cell2 In report.Range(report.Cells(1, 2), report.Cells(1, report.UsedRange.Columns.Count))
            On Error Resume Next: Err.Clear
            ' căutând sens într-o carte deschisă 
            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
            ' transferați valorile găsite în fișierul de raport 
            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

După aceea, puteți reveni la Excel și puteți rula macrocomandă prin meniu Tools - Macro - Macros (Alt+F8) .