ماكرو سبايدر لتجميع البيانات من الملفات المختلفة 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) .