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

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

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

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

 

[ابويوسف2020]

الله عليك يااستاذ ياسر ..ابداع  الف الف شكر

وادعيلكم من كل قلبي بدوام التوفيق والسداد 

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

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

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

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

ممكن ترفق شكل المخرجات بالنسبة للورقة التجميعية واسم الورقة ...

وأفضل عمل كود منفصل يقوم بالمهمة ..لأن الكود أصبح في توهاااااااان وحتى تتضح الصورة أمامكم ..أو يمكن عمل كود منفصل ثم استدعاء الكود عن طريق الأمر Call ..

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

قوم بما تبقى من المهمة حيث أنني مشغول قليلاً ..بارك الله فيك وجزيت خيراً على كلماتك الطيبة وإعجابك بالمشاركة الأخيرة لي ..اللي صاحب الموضوع نفسه تجاهلها ...!

[ابويوسف2020]

حرام عليك ياشيخ ياسر ..كيف تجاهلتك

  وفضلك مغرقنا وانت على راسنا من فوق بس شكلك ماشفت راس الموضوع والتعليق عليه او اني قلت كلمات قليلة في حقكم وانت تستحق اكثر 

         والليلة ان شاء الله ارسل لكم المخرج

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

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

لا أقصد أنك تجاهلتني أو خلافه

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

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

عموماً حصل خير ..دي حاجة عادية بس حبيت أنبه عليها بس

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

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

أنا فى انتظار شكل المخرجات بالنسبة للورقة التجميعية واسم الورقة

[ابويوسف2020]

حبيبي اخي ياسر     اشكرك على التنبيه   فلم انتبه لهذا الامر المهم وهو اقل شيء نجزيكم به وانتم تستحقون اكثر 

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

Collect Data From Multiple CSV Workbooks Mokhtar V21.rar

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

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

أخى أبو يوسف  جرب هذا الكود حساب عدد التكرار لكل مكتب في جميع الاوراق  و أبدى ملاحظاتك

Option Explicit

Sub CopyToNewSheet()
' by Mokhtar Hussien
' 25/11/2015
Dim SH As Worksheet
Dim P As Long
Dim Rng As Range
Dim Data, ColFound
Dim Obj As Object

Application.ScreenUpdating = False
Application.DisplayAlerts = False
 '-----------------------------------------------------------------
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "التجميعى"

 '-----------------------------------------------------------------
For Each SH In ThisWorkbook.Sheets
      If IsError(Application.Match(SH.Name, Array("Master", "التجميعى"), 0)) Then
        SH.Range("M2").CurrentRegion.Offset(1).Copy
        
        With Sheets("التجميعى")
              .Activate
              .Range("B1:C1") = Array("مكتب التربية", "العدد")
              .Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteAll
              With .Range("B1").CurrentRegion
                   .Range("A1:B1").Interior.Color = vbYellow
                   .Borders.Weight = xlThin
                   .BorderAround Weight:=xlThick
                   .Columns.AutoFit
              End With
         End With
      End If
Next
 '-----------------------------------------------------------------
With Sheets("التجميعى")

     ColFound = Application.Match("*مكتب التربية*", .Rows(1), 0)
     If IsNumeric(ColFound) Then
        .Range("G2:H2") = 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("G3:G1000").ClearContents
        .Range("G3").Resize(Obj.Count, 1) = Application.Transpose(Obj.keys)
        '-----------------------------------------------------------------
        With .Range("H3:H" & .Cells(Rows.Count, "G").End(xlUp).Row)
             .Formula = "=SUMPRODUCT( (R2C2:R1000C2 =RC[-1]) * R2C3:R1000C3 )*2"
             .Value = .Value
        End With
        '-----------------------------------------------------------------
        With .Range("G2").CurrentRegion
             .Borders.Weight = xlThin
             .BorderAround Weight:=xlThick
             .Columns.AutoFit
             .Range("A1:B1").Interior.Color = vbYellow
         End With
         '-----------------------------------------------------------------
         .Columns("A:F").Delete Shift:=xlToLeft
         '-----------------------------------------------------------------
        End If
End With
 '-----------------------------------------------------------------
Sheets("Master").Activate
Application.CutCopyMode = False
Application.ScreenUpdating = True
Application.DisplayAlerts = False
End Sub

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

 

Collect Data From Multiple CSV Workbooks Yasser Mokhtar final.rar

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

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

أخي الحبيب الغالي مختار بارك الله فيك ..

قمت بتعديل بسيط على كودك حيث حذفت الجزء الخاص بتنسيق النطاقات المنسوخة إذا لا داعي لها حيث أنك في نهاية المطاف تقوم بحذف الأعمدة

إليكم المرفق الأخير حيث تم الجمع بين جميع الأكواد

Collect Data From Multiple CSV Workbooks YasserKhalilMokhtar V3.rar

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

أخى وأستاذى الغالى بارك الله فيك .

اكتشفت خطأ فى المعادلة SUMPRODUCT  و تم التصحيح  

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

هذا المرفق  به كودين يتم استدعائهما  بزر  واحد 

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

السطر التالى  فى الكود الاول يحذف

 Call CopyToNewSheet

أضف  شكلا تلقائيا  أو  زر و اربطه  بالكود الثانى 

  وأى ملاحظات أخرى فأهلا و سهلا بها  فلا تخجل    تحياتى لك ولأخى وأستاذى أبا البراء

Collect Data From Multiple CSV Workbooks YasserKhalilMokhtar V 4.rar

[ابويوسف2020]

برافووو يامبدعين مهندس مختار 

والمهندس ياسر 

وفقكم الله واسعدكم كما اسعدتموني 

جاري التجربة 

[ابويوسف2020]

تحياتي وتقديري

 تظهر رسالى type  mismatch 

وارفق لكم المجلد حيث فيه مجلد الطلاب تظهر فيه هذه الرسالة

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

المطلوب من البرنامج يستدعي ملفات الاكسل في المجلد الاول ثم اقوم باستدعاء ملفات الاكسل في المجلد الثاني وهكذا 

        عند استدعاء بعض الملفات تظهر هذه الرسالةويظهر في  الملف التجميعي بيانات غير مطلوبة

 اذا بالامكان التجربة ونكون لكم من الشاكرين

 

girl.rar

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

بدون الإطلاع على المرفق ..هل لديك مصنفات بنفس الاسم أو ما شابه ؟؟

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

[ابويوسف2020]

لايوجد مصنفات بنفس الاسم 

      ولايظهر لي نافذة فيها كلمة Debug  انما تظهر نافذه فيها رسالة type mismatch 

      علما انني انتقلت الى محرر الاكواد 

اذا بالامكان القيام بالتجربة حبيبي ياسر

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

أخى أبو يوسف 

أنا مجرب الملف قبلك  عدة مرات  و لا تظهر لى هذه الرسالة

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

وجرب  المرفق الأخير  فى مشاركتى الأخيرة   Collect Data From Multiple CSV Workbooks YasserKhalilMokhtar V 4.rar

 

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

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

يوجد بالفعل خطأ في أثناء تنفيذ الكود مع الملفات التي بها صفين فقط من البيانات فقمت بتعديل الكود بحيث يزود كمان صف على الموجود

كما قمت بإدراج الإحصاء في العمودين Y و Z بدلاً من العمودين M و N لأنني لاحظت أن بعض الملفات بها بيانات في هذين العمودين

 

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

عموماً إليك المرفق التالي فيه المصنف الرئيسي ومرفق ملفات CSV الأخير المسمى girl (قم بتغيير اسمه ..ولن يؤثر في شيء)

 

Collect Data From Multiple CSV Workbooks Mokhtar YasserKhalil V4.rar

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

تمام كده 

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

ولهذا ذكرت أن الكود ليس به أخطاء خاصة و أن النتائج النهائية صحيحة 100 %  

نحن الآن بانتظار رأى أبو يوسف فى المرفق الأخير  يا رب يكون مرضى وصل لمبتغاه

 

[ابويوسف2020]

100% صحيح  

يعجز عن شكركم اخوينا مختار حسين        واخونا ياسر خليل 

واتوجه الى الله بالدعاء  لكما بأن الله يسعدكم ويفرج همكم ويرزقكم من واسع فضله

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

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

أخي الكريم أبو يوسف 5050 ..يا ريت 7090 دي تبقا لقبك أفضل ...

هنا في المنتدى نحب أن نتعرف على الأعضاء بمسمياتهم وألقابهم

الحمد لله أن تم المطلوب على خير ..

والفضل لله عزوجل ثم الأخ الحبيب مختار صاحب شرارة الإنطلاق الاولى والأخيرة ..

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

تقبل تحياتي

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

 

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

نعم الحمد لله الذى بنعمته تتم الصالحات

أخى الغالى أبا يوسف  فرحتى الآن لا تقل عن فرحتك بل تزيد  تقبل الله دعائك و لك مثله

أخى و حبيبى في الله و أستاذى ياسر بارك الله فيك ... ما أروعك ! وما أروع تلك الأثرة فيك !

لولا فضل من الله و لولا تدخلك ما وصلنا الى هذه النتيجة الرائعة

بارك الله فيك و فى أهلك و فى مالك و فى وقتك و و فقك فى خدمة اخواننا فى كل مكان

فلك مني كل التحية و التقدير

 

[ابويوسف2020]

تحياتي للمبدعين اخي ياسر  واخي مختار  

هل بالامكان تنفيذ الكود لحساب عدد التكرار لكل مدرسة بحيث يظهر كل مكتب تربية في ورقة وفيها عدد تكرار مدارسه 

                 حسب الشكل المرفق  

المكتب.rar

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

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

أفضل فتح موضوع جديد بطلبك الجديد ..

تقبل تحياتي