دمج ملفات اكسل في ملف واحد واضافة معادلة لحساب عدد التكرار

[ابويوسف2020]

السلام عليكم ،مرحبا حبايبنا

وبداية اشكر لكم حرصكم على حل مشاكل الاعضاء ومساهمتكم الفاعلة في تقديم المعرفة وتوظيفها

لدي طلب 

عندي مجلد فيه ملفات اكسل واريد دمج جميع الملفات في ملف واحد بحيث يكون كل ملف في ورقة ويسمى بإسم الملف .

بعد ذلك اريد ان احسب عدد تكرار بيانات احد الاعمدة ويصدرها الى ورقة جديدة ضمن هذا الملف(كما في المرفق ) مع اعتبار ان اسم العمود قد يتغير 

المرفقات(في الملف ) :

1-مجلد فيه جميع الملفات 

2-ملف PDF  فيه شرح توضيحي للمطلوب

 

New folder.rar

[ابويوسف2020]

معقولة مافيه حل 

الفزعه ياحبايب

الموضوع له ثلاث ايام 

[مختار حسين محمود]

رويدك أخى الكريم  الصبر الصبر

طلباتك متعددة  وهذا ما ينفر الأخوة من تلبية طلبك

الأفضل أن تضع طلبا واحدا ومحددا ثم تطلب طلبا آخر أو تعديلا 

جرب الملف ده أولا لتجميع البيانات من الملفات

شغل الكود واختار مجلدك ( معلمين ) ثم حدد الملفات التى ترغب فيها

ثم نستكمل الباقى  بإذن الله  تعالى  سواء معا أو مع الأخوة الزملاء   

-----------------------

ملحوظة

للحصول على نتائج جيدة اجعل كل الملفات بصيغة xlsx  بلاش من csv

تحياتى لك و لا تنسى تغير اسمك الى العربية

 

Collect data from multiple workbooks by mokhtar v1.rar

تم تعديل نوفمبر 21, 2015 بواسطه مختار حسين محمود

[ابويوسف2020]

بارك الله فيك اخي مختار حسين

           بعد الدمج تظهر الملفات في الصفوف والاعمدة ملخبطة

           لان اصل الملف من نوع Cvs

      وارفقت الملف هنا بعد الدمج

Collect data from multiple workbooks by mokhtar v1.rar

[مختار حسين محمود]

متأسف لم أشاهد مشاركتك الا بعد أن عدلت فى مشاركتى

ملحوظة

للحصول على نتائج جيدة اجعل كل الملفات بصيغة xlsx  بلاش من   csv  

الخطوة اللى جاية باذن الله سهلة وهى حساب عدد تكرار كل مكتب تربية وتعليم  

بعد أن تقرر : هل النتائج مرضية بعد تحويل كل ملفاتك الى صيغة xlsx  أم لا  ؟  

تم تعديل نوفمبر 21, 2015 بواسطه مختار حسين محمود

[ابويوسف2020]

اذا احتاج معادلة ثانية بتحويل الملفات من cvs  الى  xlsx

 لانه يوجد برنامج يصدر لي الملفات من نوع cvs ولايمكنني التحكم به

[ياسر خليل أبو البراء]

Sub CollectDataFromMultipleWorkbooks()
    Dim OpenFiles
    Dim crntfile As Workbook
    Set crntfile = Application.ActiveWorkbook
    Dim X As Integer
    Dim SH As Worksheet
    Dim Arr, Temp, I As Long, J As Long
    
    On Error GoTo ErrHandler
    Application.ScreenUpdating = False
        OpenFiles = Application.GetOpenFilename(FileFilter:="Microsoft Excel Files (*.csv;*.xlsx;.xlsm),*.csv;*.xlsx;*.xlsm", MultiSelect:=True, Title:="Select Excel File To Merge!")
       
        If TypeName(OpenFiles) = "Boolean" Then
            MsgBox "You Need To Select At Least One File"
            GoTo ExitHandler
        End If
    
        X = 1
        While X <= UBound(OpenFiles)
            Workbooks.Open Filename:=OpenFiles(X)
            Sheets().Move After:=crntfile.Sheets(crntfile.Sheets.Count)
            
            X = X + 1
        Wend
        Sheets("Master").Activate
        
        For Each SH In ThisWorkbook.Sheets
            With SH
                If .Name <> "Master" Then
                    Arr = .Range("A1").CurrentRegion.Value
                    For I = 1 To UBound(Arr)
                        Temp = Split(Arr(I, 1), ";")
                        For J = 1 To UBound(Temp)
                            .Cells(I, J) = Temp(J)
                        Next J
                    Next I
                    .Range("A1").CurrentRegion.Columns.EntireColumn.AutoFit
                End If
            End With
        Next SH
        
ExitHandler:
    Application.ScreenUpdating = True
    Exit Sub

ErrHandler:
    MsgBox Err.Description
    Resume ExitHandler
End Sub

أخي الحبيب مختار

بارك الله فيك على الكود الرائع الذي قدمته لنا على طبق من ذهب

أخي الكريم صاحب الموضوع ..يرجى تغيير اسم الظهور للغة العربية (راجع التوجيهات في الموضوعات المثبتة في المنتدى)

جرب الملف التالي بعد إضافة بسيطة لكود الأخ المتميز مختار ليقوم بفصل العمود الواحد لعدة أعمدة

 

تقبل تحياتي

Collect Data From Multiple CSV Workbooks Mokhtar V1.rar

[مختار حسين محمود]

أشكرك أخى و أستاذى الكبير  ياسر خليل  مشكور على التعديل اللى ما جاش على بالى  ده

 

[ابويوسف2020]

ممتار الله يعطيكم العافية 

حقا لا اعرف كيف اشكركم

الملف الذي اضافه استاذنا القدير ياسر خليل  كفى ووفى 

 والخطوة القادمة ارجو مساعدتي في 

حساب عدد تكرار كل مكتب تربية وتعليم  

[مختار حسين محمود]

  أستاذى أبا البراء كمل الجميل و خلص على الموضوع اللى بقاله 3 أيام ده

                          معلش معى مشوار ضرورى

[ابويوسف2020]

ياليت ياعم مختار ..انت راجل طيب وكريم

وان شاء الله استاذنا أبا البراء مايقصر معنا

[مختار حسين محمود]

ان شاء الله ما فيش تقصير كل ما  هنالك مشاغل الحياة تطغى علينا

المرفق التالى تم فيه جمع البيانات من المجلد كما تم حساب عدد تكرار كل مكتب تربية وتعليم  بالمعادلات

شوف الخطوة اللى جايه ايه 

Collect Data From Multiple CSV Workbooks Mokhtar V2.rar

[ابويوسف2020]

اخي مختار بارك الله فيكم

بعد جمع البيانات لاتظهر المعادلة بشكل تلقائي بحيث يتم الاحتساب مباشرة 

لدي مجلدين ارفقهما لكم واحد للبنين  - والاخر للبنات

بحيث كل مجلد لوحده يقوم باحتساب عدد تكرار كل مكتب تربية وتعليم

 

بنين.rar

بنات.rar

[ابويوسف2020]

نسيت انه احيانا عمود مكتب التعليم يختلف من مصنف الى اخر

تم تعديل نوفمبر 22, 2015 بواسطه ابويوسف2020

[مختار حسين محمود]

معلش يا أبا يوسف خلينا نمشى خطوة خطوة  

  أنت فهمت دلوقتى أنك عايز تضيف المعادلات آليا  بعد جمع البيانات ؟

وكمان  عمود المكتب  يختلف من مصنف لآخر .

تمام كده ولا فيه حاجة تانى ؟

 

[ياسر خليل أبو البراء]

أخي الكريم أبو يوسف

يبدو أنني تهت منك كما تاه أخي الغالي مختار

يا ريت توضح المطلوب بشيء من التفصيل دون نسيان أي جزئية لكي يتم العمل بشكل صحيح ...

في المرفقات مجلدين بنين وبنات ...بهما ملفات CSV .. ما هو شكل المخرج النهائي ؟؟؟

أعتقد أننا انتهينا من مرحلة تجميع البيانات في مصنف واحد في عدة شيتات وإخراج البيانات بشكل يسهل التعامل معه ..

ننتقل للجزئية التالية (وأفضل التعامل مع نقطة واحدة وبالتفصيل .. لكي لا يطول الموضوع بدون داعي)

تقبل تحياتي

 

[ابويوسف2020]

احييكم وارحب بكم 

المخرج النهائي كما في المرفق 

 

New folder (2).rar

[ياسر خليل أبو البراء]

أخي الكريم ابو يوسف

...

ما زال الطلب غامض بالنسبة لي

لقد قام أخي الغالي مختار بما تقدمت به في المرفقات ... أليس هذا صحيحاً

وسؤال لما أرفقت 4 ملفات مختلفة ؟؟؟

يقوم مبدأ الكود على تجميع البيانات من أي ملفات تختارها بنفسك ... فهل أنت من قمت بوضع هذا التصنيف من خلال أربعة ملفات أم أنك تريد من خلال الكود تصنيف الملفات بهذا الشكل؟

وإذا كان الامر كذلك ما هو المنطق المستند عليه في عمل ذلك التصنيف ؟؟

وهل الإحصائية ستكون لكل أوراق العمل التي سيتم جلبها من ملفات مختلفة ؟؟ أم أنك تريد عمل إحصائية مجمعة لكل ما تم تجميعه ؟ أم كلاهما ؟

تكثر التساؤلات في حالة عدم وضوح الأمر ..اعذرني للإطالة

[ابويوسف2020]

شكرا لك اخي ياسر

لو لاحظت في المرفق الاخير  New folder (2).ra

وجود ورقة تمت اضافتها وفيها مجموع عدد كل مكتب بحيث يكون الاجمالي في جميع الاوراق 

 وارفق لكم الشرح في هذه الصورة

المرفق الذي اضافه اخي العزيز مختار يقوم بجمع الملفات في مصنف واحد ولا وجود للمعادلة 

هذا التصنيف يتم تصديره من احد الانظمة لدينا ولايمكن لنا تغيير مسميات الاعمدة 

 

4.rar

[مختار حسين محمود]

السلام عليكم

أعتقد أخى و أستاذى ياسر أن أخانا أبا يوسف تاه قبل منى و منك   لذلك مش قادر يوضح المطلوب بسرعة وبايجاز

لكن أعتقد أنه فى النهاية يريد الآتى :

1- جلب البيانات من المجلد  وهذا ما تحقق ورضى به أخونا أبويوسف

2- حساب عدد تكرار كل مكتب تربية و تعليم  فى كل شيت  ثم تجميع التكرارات فى شيت مستقل

مش كده يا أبو يوسف و لا أنا لسه فى البطاطا ؟!!!!!!!!!!!!!!

شوف  يابو يوسف ان كان الكلام ده يمشى الحال نكمل و الا قولنا  نقف و نشوف سكة تانيه

أخى ياسر  خلى بالك معاى ( و أنا متأكد أنك معاى و ما بتفوتش )

كبداية لحساب عدد تكرار كل مكتب تربية وتعليم   فى كل ورقة

أنا عملت كود مبدئى  دخلت بيه ( فقط  ) فى كل الأوراق لكى  أتأكد من وجود النص "مكتب التربية"  فى الخلايا المتاحة فى الصف الاول

هذا هو الكود

Option Explicit
Sub countf()
 Dim SH As Worksheet
 Dim C As Range, Rng As Range

Application.ScreenUpdating = False

For Each SH In ThisWorkbook.Sheets
           
                If SH.Name <> "Master" Then SH.Activate
               
                   For Each C In ActiveSheet.Range(Range("A1"), Cells(1, Cells(1, Columns.Count).End(xlToLeft).Column))
                       If Not C.Find("*مكتب التربية*") Is Nothing Then
                          C.Activate
                          ' Set Rng = Range(ActiveCell, ActiveCell.End(xlDown))
                          Range("M1").Value = "مكتب التربية"
                          Range("N1").Value = "العدد "
                   End If
                  Next C
Next SH
Application.ScreenUpdating = True
End Sub

اللى جاى بقى : تعديل الكود ده ليحسب  عدد تكرار كل مكتب تربية وتعليم   فى كل ورقة  ثم ندمجه  مع كود جلب البيانات 

ثم ندخل على مرحلة التجميع النهائية .  مش كده اللى عايزه يا أبو يوسف و لا برضه أنا لسه فى البطاطا  

همتك معاى بقى أخى و أستاذى الغالى ياسر  فى عمل CountIf  فى الـــ  vba  أصلى ما عملتوش قبل كده 

تحياتى لكما

 

 

تم تعديل نوفمبر 22, 2015 بواسطه مختار حسين محمود

[ياسر خليل أبو البراء]

أخي الكريم مختار

ننتظر رد الأخ أبو يوسف ليتضح الأمر أكثر قبل الخوض في غمار التخمين .........!

[ابويوسف2020]

معذرة اخي مختار 

تاخذني على قد عقلي 

   اين اضيف المعادلة وكيف وهل ستكون ورقة لوحدها 

[ياسر خليل أبو البراء]

أخي الكريم أبو يوسف

الأخ مختار قدم تخمين للمطلوب عمله .. ولم يقدم الحل بشكل كامل إنما بشكل مبدئي لمعرفة كيفية شكل المخرجات

ومن أمس ونحن في انتظار تأكيد شكل المخرجات

أنت تريد إحصائية كالتي قام بها الأخ الحبيب مختار في كل ورقة عمل ... ثم إنشاء ورقة تجميعية لكل الإحصائيات الموجودة في أوراق العمل ؟؟ أليس هذا المطلوب أم أنه هناك لبس في الموضوع

[ياسر خليل أبو البراء]

أخي الحبيب مختار

يمكن استخدام الدالة Match لمعرفة رقم العمود الخاص بمكتب التربية دون اللجوء إلى الحلقات التكرارية التي من شأنها أن تبطيء عمل الأكواد بشكل ملحوظ

 

Sub CountIf()
    Dim SH As Worksheet
    Dim ColFound
    
    Application.ScreenUpdating = False
        For Each SH In ThisWorkbook.Sheets
            If SH.Name <> "Master" Then
                ColFound = Application.Match("*مكتب التربية*", SH.Rows(1), 0)
               If IsNumeric(ColFound) Then MsgBox ColFound
            End If
        Next SH
    Application.ScreenUpdating = True
End Sub

[ياسر خليل أبو البراء]

أخي الكريم أبو يوسف

لم يتم الرد للآن وتأكيد الطلب (ورغم أنني من أنصار عدم تقديم المساعدة إلا إذا توافر الشرح الكافي للطلب بالتفصيل ولكن ما باليد حيلة) سأقوم بطرح ما قام به أخونا الحبيب مختار عن طريق الأكواد بعيداً عن معادلات الصفيف ..

الآن تم دمج الطلبات بشكل مبدئي ..الجزء الأول تحدد الملفات المراد تجميعها ثم يتم تجميعها كل ملف أو مصنف في ورقة عمل ، ثم الجزء الثاني يتم استخراج مكاتب التربية الغير مكررة في العمود M وفي العمود المقابل له عدد هذه المكاتب ...

إذا كان للطلب بقية فأفضل أن يكون في كود منفصل .. حتى لا نتوه بين أسطر الأكواد ..

إليك الكود بالشكل النهائي له

Sub CollectDataFromMultipleWorkbooks()
    Dim OpenFiles
    Dim crntfile As Workbook
    Set crntfile = Application.ActiveWorkbook
    Dim X As Integer
    Dim SH As Worksheet
    Dim Arr, Temp, I As Long, J As Long, P As Long
    Dim Rng As Range, ColFound
    Dim Data As Variant
    Dim Obj As Object
    
    On Error GoTo ErrHandler
    Application.ScreenUpdating = False
        OpenFiles = Application.GetOpenFilename(FileFilter:="Microsoft Excel Files (*.csv;*.xlsx;.xlsm),*.csv;*.xlsx;*.xlsm", MultiSelect:=True, Title:="Select Excel File To Merge!")
        
        If TypeName(OpenFiles) = "Boolean" Then
            MsgBox "You Need To Select At Least One File"
            GoTo ExitHandler
        End If
        
        X = 1
        While X <= UBound(OpenFiles)
            Workbooks.Open Filename:=OpenFiles(X)
            Sheets().Move After:=crntfile.Sheets(crntfile.Sheets.Count)
            X = X + 1
        Wend
        
        For Each SH In ThisWorkbook.Sheets
            With SH
                If .Name <> "Master" Then
                    Arr = .Range("A1").CurrentRegion.Value
                    For I = 1 To UBound(Arr)
                        Temp = Split(Arr(I, 1), ";")
                        For J = 1 To UBound(Temp)
                            .Cells(I, J) = Temp(J)
                        Next J
                    Next I
                    .Range("A1").CurrentRegion.Columns.EntireColumn.AutoFit
                    
                    ColFound = Application.Match("*مكتب التربية*", .Rows(1), 0)
                    If IsNumeric(ColFound) Then
                        With .Columns("M:N")
                            .ClearContents
                            .Borders.LineStyle = xlNone
                            .Interior.Color = xlNone
                        End With
                        
                        .Range("M2:N2") = Array("مكتب التربية", "العدد")
                        Set Rng = .Range(.Cells(2, ColFound), .Cells(.Cells(Rows.Count, ColFound).End(xlUp).Row, ColFound))
                        Set Obj = CreateObject("scripting.dictionary")
                        Data = Rng
                        For P = 1 To UBound(Data)
                            Obj(Data(P, 1) & "") = ""
                        Next
                        
                        .Range("M3:M1000").ClearContents
                        .Range("M3").Resize(Obj.Count, 1) = Application.Transpose(Obj.keys)
                        
                        With .Range("N3:N" & .Cells(Rows.Count, "M").End(xlUp).Row)
                            .Formula = "=COUNTIF(" & Rng.Address & ",M3)"
                            .Value = .Value
                        End With
                        
                        With .Range("M2").CurrentRegion
                            .Range("A1:B1").Interior.Color = vbYellow
                            .Borders.Weight = xlThin
                            .BorderAround Weight:=xlThick
                            .Columns.AutoFit
                        End With
                    End If
                End If
            End With
        Next SH
    
ExitHandler:
    Application.ScreenUpdating = True
    Exit Sub

ErrHandler:
    MsgBox Err.Description
    Resume ExitHandler
End Sub

تقبل تحياتي

Collect Data From Multiple CSV Workbooks Mokhtar V2.rar