إجمالي مرات مشاهدة الصفحة

الأربعاء، 27 أبريل 2016

جلب بيانات من جميع أوراق مصنف مغلق Grab Data From All Sheets In Closed Workbook

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

أقدم لكم كود يقوم بجلب واستدعاء بيانات من جميع أوراق العمل في مصنف مغلق.

بفرض أن لديك مجموعة مصنفات مغلقة وتمت تسميتها بالسنوات أي مصنف باسم 2013 ومصنف باسم 2014 وهكذا ..

وفي كل مصنف من هذه المصنفات يوجد عدد 12 ورقة عمل بشهور السنة (يناير - فبراير - مارس - وهكذا ...)
وفي كل ورقة عمل يوجد خلايا محددة تريد جلبها للمصنف الحالي في ورقة العمل Sheet1
والمطلوب جلب بيانات هذه الخلايا الثلاثة الموجودة في كل ورقة عمل في المصنف المغلق إلى ورقة العمل Sheet1 بهذا الشكل
وذلك بالاعتماد على قيمة الخلية B3 التي تحتوي على اسم المصنف المغلق المراد جلب البيانات منه

كل ما عليك فعله هو أن تقوم بكتابة أو ختيار اسم المصنف من الخلية B3 ثم النقر على زر الأمر RUN (مع العلم أنه يمكن تفعيل الكود بمجرد التغير في قيمة الخلية) ، فيقوم الكود بفحص مسار المصنف للتأكد من وجود المصنف من عدمه ، فإذا لم يكن المصنف موجود يتم إظهار رسالة تفيد بذلك ، أما إذا كان المصنف موجود فيتم فتح المصنف المغلق ويتم عمل حلقة تكرارية لكل أوراق العمل لتخزين قيم الخلايا المطلوب استدعائها ثم يغلق المصنف وأخيراً توضع قيم المصفوفة في النطاق B6:M8

إليكم الكود المستخدم لتنفيذ المهمة ، ويوضع الكود في موديول عادي

Sub Grab_Data_From_Closed_Workbook()
    Dim strFileName     As String
    Dim Arr             As Variant
    Dim Temp            As Variant
    Dim Sh              As Worksheet
    Dim Counter         As Integer
    Dim I               As Integer

    strFileName = ThisWorkbook.Path & "\" & Sheet1.Range("B3").Value & ".xls"

    Application.ScreenUpdating = False
        Sheets("Sheet1").Range("B6:M8").ClearContents
        
        If Len(Dir(strFileName)) > 0 Then
            Workbooks.OpenText Filename:=strFileName
    
            ReDim Temp(1 To 12, 1 To 3)
    
            For Each Sh In ActiveWorkbook.Worksheets
                With Sh
                    Counter = Counter + 1
                    Arr = Array(.Range("C6").Value, .Range("E6").Value, .Range("G6").Value)
                    I = I + 1
                    For Counter = 1 To 3
                        Temp(I, Counter) = Arr(Counter - 1)
                    Next Counter
                End With
            Next Sh
            
            ActiveWorkbook.Close False
            
            Sheets("Sheet1").Range("B6").Resize(UBound(Temp, 2), UBound(Temp, 1)).Value = Application.Transpose(Temp)
        Else
            MsgBox strFileName & " Can't Be Found!", vbExclamation, "File Not Found"
        End If
    Application.ScreenUpdating = True
End Sub

إعداد / ياسر خليل أبو البراء

هناك 13 تعليقًا:

  1. ماشاء الله مهم جدا الموضوع دا تحديدا

    ردحذف
  2. بارك الله فيك هل الكود مصمم لجلب ثلاث خلايا فقط ام انه قادر على جلب اى عدد من الخلايا

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

    ردحذف
  4. الف شكر مهندس ياسر بس لو سمحت ممكن فيديو شرح لهذه الأكواد واذا كانت الخلايا المراد جلبها غير متجاور فكيف يكون الكود وهل اذا تم تغيير أسماء الخلايا المراد جلبها سوف نحتاج تغيير الكود ام ماذا ولو سمحت أريد ان يكون التعديل بمجرد التغيير في قمية الخلايا وألف شكر مرة أخري علي المجهود الرائع

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

    ردحذف
  6. يرجي من سيادتك إضافة شرح للكود حتي نستطيع تطبيقة وشكرا

    ردحذف
  7. أخي الكريم محمد قم بالإطلاع على الكود وحدد الأسطر التي تريد شرحها

    ردحذف
    الردود
    1. If Len(Dir(strFileName)) > 0 Then
      Workbooks.OpenText Filename:=strFileName

      ReDim Temp(1 To 12, 1 To 3)

      For Each Sh In ActiveWorkbook.Worksheets
      With Sh

      حذف
  8. الأسطر دي تعني أن لو المسار موجود (ودا بيتم اختباره عن طريق الدالة LEN) فلو كان المصنف موجود يتم تنفيذ التالي
    ألا وهو فتح المصنف في المسار المحدد
    أما جملة ReDim فتقوم بإعادة أبعاد المصفوفة المسماة Temp بحيث تتسع لعدد أوراق العمل 12 ، والبعد الثاني للخلايا الثلاثة في كل ورقة عمل من الأوراق الإثنى عشر
    ثم بعد ذلك حلقة تكرارية لكل أوراق العمل في المصنف النشط (أي المصنف الذي تم فتحه)
    أرجو أن يفي هذا بالغرض

    ردحذف
  9. ألف شكر بس لو سمحت المثال الي معنا يتم تجميع بيانات من كل شيت الي مجمع لو انا عاوز استدعاء مثلا بيانات شيت شهر يناير لجميع العاملين في شيت يناير وبيانات شهر فبراير لجميع العاملين في شيت فبراير بحيث يكون يناير وفبراير وهكذا في شيت واحد والف شكر مره أخري

    ردحذف
  10. الفكرة واحدة وسيكون التعديل بسيط إن شاء الله ، يمكنك طرح موضوع بالمنتدى مع إرفاق ملف للعمل عليه ، مع التوضيح التام لشكل النتائج المتوقعة

    ردحذف
  11. .انضم إلى eToro وقُد ثورة التكنولوجيا المالية

    حكمة الجموع المتداولون الذين يستخدمون CopyTrader™ من eToro يزيد احتمال أن يحققوا أرباحًا بنسبة 60%

    ردحذف