Çeşitli dosyalardan veri toplamak için örümcek makrosu Excel

Tanım

Bu yazımızda birçok çalışma kitabındaki verileri arayabilen ve seçilen bilgileri ayrı bir rapor dosyasına kaydedebilen bir makro örneğini ele alacağız.

Bunu yapmak için kitabınızı açın, şu adrese gidin: Visual Basic Editor (Alt+F11) , yeni bir modül boş ekle (Insert - Module) ve bu makro metnini buraya kopyalayın:

Sub Report_file()
'moonexcel.com.ua
Application.ScreenUpdating = False ' ekran yenilemeyi devre dışı bırak 

    Set report = Workbooks("Report.xlsb").Worksheets(1)
    find_field = report.[a1]
    
    ' içe aktarılacak dosyaları seçmek için iletişim kutusunu aç 
    FilesToOpen = Application.GetOpenFilename _
      (FileFilter:="All files (*.*), *.*", _
      MultiSelect:=True, Title:=" Dosyaları seçin! ")

    If TypeName(FilesToOpen) = "Boolean" Then
        MsgBox " Dosya seçilmedi! "
        Exit Sub
    End If
    
    ' seçilen tüm dosyaları tek tek inceliyoruz 
    m = 1
    While m <= UBound(FilesToOpen)
        Set importWB = Workbooks.Open(Filename:=FilesToOpen(m))
        Set importWS = importWB.Worksheets(1)
    
        ' hücreleri yendik”  şapkalar  " 
        For Each cell2 In report.Range(report.Cells(1, 2), report.Cells(1, report.UsedRange.Columns.Count))
            On Error Resume Next: Err.Clear
            ' açık bir kitapta anlam aramak 
            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
            ' Bulunan değerleri rapor dosyasına aktarın 
            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

Bundan sonra Excel'e dönüp menü üzerinden makromuzu çalıştırabilirsiniz. Tools - Macro - Macros (Alt+F8) .