جلب بيانات محددة من مصنف لآخر

[أبو عبدالإله]

لدي ثلاثة مصنفات

المصنف الأول والثاني فيها الجدول يتسع لعشرين طالب ولكن الأسماء الموجود فعليا هي 6 أسماء

 

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

يعني أحدد أمر يجلب بيانات عشرين خلية ولكن يتجاهل الخلايا الفارغة بدون اسم ، ولكن عند اضافة اسم جديد مستقبلا يتم جلبه مبشرة 

 

لعل الأمر يكون أكثر وضوحا في المرفقات :

 

جلب بيانات.rar

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

جرب أخي الحبيب المرفق التالي

Get Data.rar

[أبو عبدالإله]

جرب أخي الحبيب المرفق التالي

 

 

 

هذا هو المطلوب 

 

والله لو كنت قريبا منك لقبلت جبينك يا ابن الكرام

 

ولكن لك دعوات خارجة من القلب دائما .

 

حفظك الله ورعاك ويسر أمورك كما تيسر أمورنا ،

 

فما تقوم به من مساعدة لا يدل إلا على نبل أخلاقك وعظيم صفاتك .

 

فلك كل الشكر والتقدير   

[أبو عبدالإله]

أخي الغالي ياسر 

 

إن لم يكن هناك ثقل عليك هل نستطيع جلب البيانات في العمود c بالإضافة للمعلومات في العمود b

 

بمعني أن نجلب الفصول أيضا إضافة للأسماء .

وإن أردت إضافة مصنفات إضافية مستقبلا فأين أضع مسارها ؟! 

 

لقد نسيت أن أوضح ذلك في موضوعي .

 

أعلم بضيق وقتك .

 

فإن لم تجد الوقت للإجابة فالعذر لك

ولك كل الشكر والتقدير فلقد قمت بالمطلوب وبشكل سريع جدا .

فجزاك الله كل خير .

[ibn_egypt]

أخي الغالي ياسر 

 

إن لم يكن هناك ثقل عليك هل نستطيع جلب البيانات في العمود c بالإضافة للمعلومات في العمود b

 

بمعني أن نجلب الفصول أيضا إضافة للأسماء .

وإن أردت إضافة مصنفات إضافية مستقبلا فأين أضع مسارها ؟! 

 

لقد نسيت أن أوضح ذلك في موضوعي .

 

أعلم بضيق وقتك .

 

فإن لم تجد الوقت للإجابة فالعذر لك

ولك كل الشكر والتقدير فلقد قمت بالمطلوب وبشكل سريع جدا .

فجزاك الله كل خير .

 

أخى الفاضل

 

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

 

تحياتي  

Get Data.rar

[أبو عبدالإله]

 

أخي الغالي ياسر 

 

إن لم يكن هناك ثقل عليك هل نستطيع جلب البيانات في العمود c بالإضافة للمعلومات في العمود b

 

بمعني أن نجلب الفصول أيضا إضافة للأسماء .

وإن أردت إضافة مصنفات إضافية مستقبلا فأين أضع مسارها ؟! 

 

لقد نسيت أن أوضح ذلك في موضوعي .

 

أعلم بضيق وقتك .

 

فإن لم تجد الوقت للإجابة فالعذر لك

ولك كل الشكر والتقدير فلقد قمت بالمطلوب وبشكل سريع جدا .

فجزاك الله كل خير .

 

أخى الفاضل

 

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

 

تحياتي  

 

 

 

 

قبلة على جبينك أيها الشهم أ.  ابن مصر

 

أبدعت كماأبدع الشهم أ. ياسر

 

الكلمات لاتوفيكما حقكما .

 

ولكن أبشروا بدعوات صادقة في جوف الليل

 

 

حفظكما الله وبارك في علمكما وعملكما ووفقكما لما فيه خيري الدنيا والآخرة

[أبو عبدالإله]

سؤال للاستفادة فقط  فما قمتما به أكثر من راائع :

 

إن أردت أن اضع الملفات في مجلد فرعي من المجلد الرئيسي الذي يوجد به الملف الرئيسي  مثلا اسم الفرعي ( البيانات )

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

 

 فكيف سيكون المسار الذي سيكتب في الكود ؟

 

مرفق الملف للتوضيح

 

 

 

بيانات الطلاب.rar

[أبو عبدالإله]

هل بالإمكان وضع محرك بحث في نفس صفحة الملف الرئيسي التي بها الأسماء  بحيث يكون البحث بخيارين إما باسم الطالب أو الصف 

فعند البحث باسم الطالب يظهر الاسم وصفه

 

وعند البحث عن الصف تظهر جميع أسماء الطلاب في هذا الصف .

 

 

أعلم أنني قد أثقلت عليكم ، لكن لاغنى لي عنكم أحبتي 

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

أخي الحبيب التاج

بارك الله فيك وجزيت خيراً على كلماتك الرقيقة ودعائك الطيب ..أرجو الله أن يتقبل دعائك

بالنسبة للكود في المشاركة السابقة لم يكن يجلب كل البيانات ولم ألاحظ ذلك إلا الآن حيث أن هناك اسم ياسر في الصف رقم 20 لم يتم جليه بالكود السابق ..

إليك الملف التالي فيه نسخ النطاق B2:C21 وكذلك التخلص من الفراغات ...وكذلك وضعت لك المصنفات الفرعية في مجلد .

وضعت بعض التعليقات التي قد تفيدك في الكود ، ويمكنك الإطلاع على الكود بالضغط على Alt + F11 للدخول لمحرر الأكواد

تفضل أخي الغالي

بيانات الطلاب.rar

[أبو عبدالإله]

سلمت يداك

 

عمل متقن وإبداع لا حدود له 

 

يعجز اللسان عن الشكر

 

رزقك الله أخي الكريم من حيث لا تحتسبت 

 

ونسأله سبحانه أن  يوفقك وييسر أمورك كلها 

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

يكفيني تلك الدعوات منك أخي الحبيب

جزيت خير الجزاء على دعواتك الطيبة ، ولك بمثل إن شاء الله

[أبو عبدالإله]

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

 

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

 

 

حاولت أن أعدل على الماكرو لكني لم أوفق ، فلم يكن أمامي إلا أنتم لمساعدتي 

 

لقد أبدع الأستاذ القدير ياسر في المساعدة بيض الله وجهه 

 

ولكن لظروف التغيير في بعض عملي فما أرديه هو :

 

جلب بيانات العمود b ووضعها في العمود b في المصنف الرئيسي . ( موجود سابقا ولا يحتاج تعديل )

 

جلب بيانات العمود (( D ))  ووضعها في العمود C في المصنف الرئيسي ( وهنا التغيير لأن الموجود في الملف يجلب بيانات العمود c  ويضعها العمود C  ونظرا لما طرأ على عملي من بعض التغيير فأنا أريد جلب بيانات العمود D وليس C ووضها في نفس العمود في الملف الرئيسي C

 

ولعل الصورة تتضح أكثر من خلال الملف المرفق 

 

 

بيانات الطلاب.rar

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

جرب الكود بهذا الشكل :

Sub GetDataNew()
    Dim SummarySheet As Worksheet
    Dim FolderPath As String
    Dim NRow As Long
    Dim FileName As String
    Dim WorkBk As Workbook
    Dim LR As Long, X, I, Y
    'اسم ورقة العمل المراد نسخ البيانات إليها
    Set SummarySheet = ThisWorkbook.Worksheets("ورقة1")
        '=================================================
        ''يمكن تغيير المسار من هذا السطر
        ''FolderPath = ThisWorkbook.Path & "\"
        '' السطر السابق إذا كانت الملفات المراد جلب البيانات منها مع المصنف الرئيسي في نفس المجلد
        ''مسار المجلد الذي سيحوي المصنفات التي سيتم جلب البيانات منها
        FolderPath = ThisWorkbook.Path & "\بيانات الفصول\"
        '=================================================
    NRow = 2 'أول صف لنسخ البيانات فيه في المصنف الحالي
    'مسح النطاق الذي ستظهر فيه النتائج
    Range("B2:C1000").ClearContents
    FileName = Dir(FolderPath & "*.xl*")
    Application.ScreenUpdating = False
        Do While FileName <> "" And FileName <> ThisWorkbook.Name
            For I = 2 To 21 'الصفوف من الصف الثاني إلى الصف الثاني والعشرون
                X = ExecuteExcel4Macro("len('" & FolderPath & "[" & FileName & "]ورقة1'!R" & I & "C2)")
                If Not IsError(X) Then
                    If X > 0 Then
                        'نسخ العمود الثاني
                        SummarySheet.Range("B" & NRow).Value = ExecuteExcel4Macro("'" & FolderPath & "[" & FileName & "]ورقة1'!R" & I & "C2")
                        'نسخ العمود الرابع
                        SummarySheet.Range("C" & NRow).Value = ExecuteExcel4Macro("'" & FolderPath & "[" & FileName & "]ورقة1'!R" & I & "C4")
                        NRow = NRow + 1
                    End If
                End If
            Next
            FileName = Dir()
        Loop
        Range("A1").Select
    Application.ScreenUpdating = True
End Sub

[أبو عبدالإله]

أنار الله قلبك ويسر دربك ورزقك الجنة بلا حساب ولا عقاب .

 

شكرا شكرا لك من الأعماق  أستاذي القدير ياسر   

[أبو عبدالإله]

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

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

 

أخي الكريم طرأ بعض التعديل وهو :

كانت المصنفات تجمع كلها في مجلد ويتم جلب البيانات في المصنف الرئيسي .

الآن أصبح كل مصنف في مجلد منفصل وحاولت مرارا أن أغير في مسار المجلد الذي يحوي المصنفات ولكن لم أستطع .

 

حقيقة لم أرد أن أثقل عليكم ، ولكن كان الفشل في كل مرة أحاول فيها .

 

 

 مجلد جديد __.rar

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

أخي الكريم المجلد فارغ ليس به ملفات

[أبو عبدالإله]

أعتذر وهذا هو الملف مرة أخرى :

 بيانات.rar

 

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

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

عموم الأمر جرب الكود التالي

Sub GetDataNew()
    Dim SummarySheet As Worksheet
    Dim FolderPath As String
    Dim NRow As Long
    Dim FileName As String
    Dim WorkBk As Workbook
    Dim LR As Long, X, I, Y, T As Long

    Set SummarySheet = ThisWorkbook.Worksheets("ورقة1")
    NRow = 2
    Range("B2:C1000").ClearContents

    Application.ScreenUpdating = False
    For T = 1 To 13
        FolderPath = ThisWorkbook.Path & "\" & T & "\"
        FileName = Dir(FolderPath & "*.xl*")
        Do While FileName <> "" And FileName <> ThisWorkbook.Name
            For I = 2 To 21
                X = ExecuteExcel4Macro("len('" & FolderPath & "[" & FileName & "]ورقة1'!R" & I & "C2)")
                If Not IsError(X) Then
                    If X > 0 Then
                        SummarySheet.Range("B" & NRow).Value = ExecuteExcel4Macro("'" & FolderPath & "[" & FileName & "]ورقة1'!R" & I & "C2")
                        SummarySheet.Range("C" & NRow).Value = ExecuteExcel4Macro("'" & FolderPath & "[" & FileName & "]ورقة1'!R" & I & "C4")
                        NRow = NRow + 1
                    End If
                End If
            Next
            FileName = Dir()
        Loop
    Next T
        Range("A1").Select
    Application.ScreenUpdating = True
End Sub

 

[أبو عبدالإله]

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

 

لقد قدم شخصكم الكريم الحل المناسب وهو بالضبط ما أريد ، فلكم مني الشكر والتقدير .

 

سلمت وسلم لك من تحب أستاذنا الفاضل ياسر  .

 

تقبل اعتذاري مرة أخرى 

[أبو عبدالإله]

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

عموم الأمر جرب الكود التالي

Sub GetDataNew()
    Dim SummarySheet As Worksheet
    Dim FolderPath As String
    Dim NRow As Long
    Dim FileName As String
    Dim WorkBk As Workbook
    Dim LR As Long, X, I, Y, T As Long

    Set SummarySheet = ThisWorkbook.Worksheets("ورقة1")
    NRow = 2
    Range("B2:C1000").ClearContents

    Application.ScreenUpdating = False
    For T = 1 To 13
        FolderPath = ThisWorkbook.Path & "\" & T & "\"
        FileName = Dir(FolderPath & "*.xl*")
        Do While FileName <> "" And FileName <> ThisWorkbook.Name
            For I = 2 To 21
                X = ExecuteExcel4Macro("len('" & FolderPath & "[" & FileName & "]ورقة1'!R" & I & "C2)")
                If Not IsError(X) Then
                    If X > 0 Then
                        SummarySheet.Range("B" & NRow).Value = ExecuteExcel4Macro("'" & FolderPath & "[" & FileName & "]ورقة1'!R" & I & "C2")
                        SummarySheet.Range("C" & NRow).Value = ExecuteExcel4Macro("'" & FolderPath & "[" & FileName & "]ورقة1'!R" & I & "C4")
                        NRow = NRow + 1
                    End If
                End If
            Next
            FileName = Dir()
        Loop
    Next T
        Range("A1").Select
    Application.ScreenUpdating = True
End Sub

 

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

 

تقبل الله منكم صيامكم وأسأل الله أن يجزل الثواب لكم ولأخي الحبيب ياسر ذي الأيادي البيضاء .

 

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

 

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

 

فأتمنى من يتسطيع مساعدتي أن يمد لي يد العون وأكون له من الشاكرين ,

 بيانات.rar

 

تم تعديل أكتوبر 24, 2015 بواسطه أبو عبدالإله
تكرار في المرفق