كود استدعاء بيانات من ورقة الأرشيف حسب رقم الإذن

[عاشق الاكسيل]

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

اساتذتى الاعزاء

مطلوب كود لاستدعاء بيانات اذن صرف من صفحة Archive عن طريق رقم اذن الصرف

وشكرا

Project.rar

[عاشق الاكسيل]

ياريت حد ينفذ المطلوب لان الموضوع مهم جدا جدا

[أبوعيد]

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

تفضل

Project1.rar

[إبراهيم ابوليله]

اخى ابوعيد

بارك الله فيك

كود جميل

واجابه موفقه

تقبل تحياتى

[عاشق الاكسيل]

14 ساعات مضت, أبوعيد said:

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

تفضل

Project1.rar

شكرا استاذى على المساعدة

ولكن الكود لا يعمل بشكل صحيح

فعند الاستدعاء لا يتم جلب كامل البيانات

فجانب المدين لا ياتى بكامل بياناته

كما يجى عند استدعاء بيانات يتم مسح محتويات الاذن حتى يتم استدعاء بيانات الاذن فقط

مثال توضيحى

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

يرجى التعديل على الكود وشكرا

[أبوعيد]

السلام عليكم 

أخي كلامك صحيح يوجد خطأ في الكود وقمت بتصحيحه

لكن لم أفهم المثال التوضيحي الذي ذكرته

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

تحياتي

Project2.rar

[عاشق الاكسيل]

استاذى ابو عيد

بداية شكرا جدا على متابعتك للموضوع وتقديم المساعدة

ولكن ما زالت ملاحظتى كما هى يرجى تجربة استدعاء بيانات الاذن رقم 1 ثم استدعاء بيانات الاذن رقم 2 وسوف يتلاحظ لكم الكتابة فوق البيانات

 

 

Project2.rar

[احمد السيد سليمان]

بعد التحية

الكود جميل ولكن تحتاج تعديل لكىيراعى حجم بيانات الاذن

حيث ان عدد مفردات ( السطور ) الاذن تختلف من اذن لاخر

[أبوعيد]

نعم فهمت مطلوبك ولكن يوجد هناك شيء غير منطقي

لاحظ معي

إذا كان إذن 1  المستفيد هو أحمد  ومناولة على

         إذن 2  المستفيد هو صالح ومناولة محمد

توجد خانة واحدة للمستفيد وخانة واحدة للمناولة

فأنت تريد استدعاء بيانات الإذن 1 ثم استدعاء الإذن 2 تحته

طيب وخانة المستفيد وخانة المناولة ستأخذ أي بيانات ؟ هل إذن 1 أو إذن 2 ؟

تحياتي

[احمد السيد سليمان]

حسب فهمى 

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

حيث المطلوب هو  استدعاء بيانات الاذن المحدد رقمه فقط ( اى ان حجم البيانات Rangeيتغير من اذن الى اخر )

اذن 1 يتكون من 3 سطور

مدين	دائن	التوجيه المحاسبى
500		اذن 1
500		اذن 1
	100	اذن 11

اذن 2 يتكون من 9 سطور

500		اذن 2
500		اذن 2
500		اذن 2
100		اذن 2
100		اذن 2
100		اذن 2
222		اذن 2
55		اذن 2
55	2132	اذن 22

وهكذا 

 

 

اقتباس

 

 

[عاشق الاكسيل]

بالضبط استاذي المشكلة في بيانات الاذن وليس المستفيد والمناولة

كما اشار الاخ احمد سليمان 

برجاء تعديل الكود

[أبوعيد]

تم التعديل تفضل

Project3.rar

[عاشق الاكسيل]

سلمت يمينك

تسلم استاذى أبو عيد

الكود يعمل بشكل رائع

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

 

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

أخي الكريم أبو عيد

لما لا ترفق الكود في المشاركة ...مع الملف المرفق ...

ننتظر منك شرح لأسطر الكود .. نريد أن ننهل من إبداعك أخي الغالي أبو عيد

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

تقبل تحياتي

[عاشق الاكسيل]

بالفعل اخى الكريم

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

[احمد السيد سليمان]

كود جميل 

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

[saad abed]

اخى ابوعيد

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

اكواد رائعة

يا ريت شرح كود الترحيل  على الاسطر ولك الشكر

 

تم تعديل يناير 8, 2016 بواسطه سعد عابد

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

أخي الكريم عاشق الإكسيل

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

Sub RecallDataEid()
'يقوم الكود باستدعاء بيانات الأذون من ورقة الأرشيف بناءً على رقم الإذن
'------------------------------------------------------------------
    'تعريف المتغيرات المستخدمة في الكود
    Dim A As Integer, LR As Long, LR1 As Long, R As Integer, T As Integer
    
    'شرط لاختبار وجود خطأ في حالة عدم وجود رقم الإذن
    'وتتم عملية البحث في ورقة الأرشيف في النطاق المحدد [M5] يتم البحث عن رقم الإذن الموجود في الخلية
    If IsError(Application.Match([M5].Value, Sheets(3).[A1:A2000], 0)) Then
        'إظهار رسالة للمستخدم في حالة عدم وجود رقم الإذن والخروج من الإجراء الفرعي
        If MsgBox("رقم الإذن غير موجود" & vbCrLf & "هل تريد مسح بيانات الإذن الموجودة؟", vbYesNo + vbExclamation) = vbYes Then
            Range("B20:K33") = "": Range("C10,C12,C16") = ""
        End If
        Exit Sub
    Else
        'إلغاء تحديث الشاشة أثناء عمل الكود لتسريع الكود
        Application.ScreenUpdating = False
        
        'تعيين قيمة للمتغير ليساوي رقم الصف الموجود فيه رقم الإذن في ورقة الأرشيف
        A = Application.Match([M5].Value, Sheets(3).[A1:A2000], 0)
        
        'الحصول على رقم آخر صف في ورقة الأرشيف في عمود التوجيه المحاسبي
        LR = Sheets(3).Range("I" & Rows.Count).End(xlUp).Row + 1
        
        'تعيين قيمة المتغير ليساوي 20 وهو يمثل رقم أول صف سيتم وضع بيانات الإذن فيه
        R = 20
        
        'مسح النطاق الذي ستوضع فيه بيانات الإذن
        [B20:K33] = ""
        
        'الحصول على رقم آخر صف يلي الصف الذي يطابق رقم الإذن
        'أي آخر صف لنفس الإذن المطابق لرقم الإذن بحيث يتم جلب جميع بيانات الإذن
        LR1 = Sheets(3).Range("A" & A).End(xlDown).Row
        
        'في حالة أن المتغير أكبر من أو يساوي آخر صف في ورقة العمل
        'يتم تعيين قيمة المتغير ليساوي رقم آخر صف بناءً على عمود التوجيه المحاسبي
        If LR1 >= Rows.Count Then LR1 = LR
        
        'حلقة تكرارية بدايةً من الصف الذي يقع فيه رقم الإذن في ورقة الأرشيف
        'إلى آخر صف في العمود الأول بعد الصف المطابق لرقم الإذن في ورقة الأرشيف
        For T = A To LR1 - 1
            
            'كبداية الحلقة تساوي الخلية في العمود الثامن في ورقة الأرشيف [B20] الخلية
            'في نفس الصف الذي يطابق رقم الإذن ، فلو كان رقم الإذن = 2 فالصف سيكون 5
            Range("B" & R) = Sheets(3).Range("G" & T).Value
            
            'نفس السطر السابق وينطبق على عمود الدائن
            Range("D" & R) = Sheets(3).Range("H" & T).Value
            
            'نفس السطر السابق وينطبق على عمود التوجيه المحاسبي
            Range("F" & R) = Sheets(3).Range("I" & T).Value
            
            'زيادة رقم صف البداية والذي كان يساوي 20 بمقدار 1 استعداداً للحلقة التالية
            R = R + 1
            
            'الانتقال للحلقة التالية
        Next T
        
        'الخلية تساوي الاسم الموجود في عمود المستفيد في نفس صف رقم الإذن
        [C10] = Sheets(3).Range("D" & A).Value
        
        'الخلية تساوي الاسم الموجود في عمود المناولة في نفس صف رقم الإذن
        [C12] = Sheets(3).Range("E" & A).Value
        
        'الخلية تساوي الاسم الموجود في عمود البيان في نفس صف رقم الإذن
        [C16] = Sheets(3).Range("F" & A).Value
        
        'إعادة تفعيل تحديث الشاشة
        Application.ScreenUpdating = True
    End If
End Sub

أرجو أن يفي بالغرض ..

تقبل تحياتي

[عاشق الاكسيل]

اخى واستاذى ياسر خليل أبو البراء

الكود يعمل بشكل سليم 100% وطبعا يفى بالغرض

لا اجد من الكلمات ما اشكرك به سوء الدعاء لك ولاسرتك الكريمة

وشكرا على نصيحتك بخصوص عمل كل طلب فى موضوع منفصل متمنيا من الله انهاء هذا العمل فى اقرب وقت ممكن

وشكرا لاستاذى أبوعيد

على مساعدته وعلى هذا الكود الاكثر من رائع متمنيا له دوام الصحة والعافية

 

تم تعديل يناير 8, 2016 بواسطه عاشق الاكسيل

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

أخي الكريم عاشق الإكسيل

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

نسأل الله له العافية والسلامة في الدنيا والآخر

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

وأخيراً الحمد لله الذي بنعمته تتم الصالحات

تقبل تحياتي

[احمد السيد سليمان]

شكرا لكل من الاستاذ ابوعبيد ، والاستاذ ياسر خليل

على الكود الرائع والسرعة فى مساعدة الجميع 

[أبوعيد]

شكرا للجميع على المساعدة 

كلنا يكمل بعضه بعضا 

نعم صحيح لم أتمكن من الرد لانشغالي

الحمدلله أنه يوجد من الأخوة الأعزاء من يسد الفراغ

شكرا لك أخ ياسر للمساعدة

تحياتي للجميع

[عاشق الاكسيل]

20 دقائق مضت, أبوعيد said:

شكرا للجميع على المساعدة 

كلنا يكمل بعضه بعضا 

نعم صحيح لم أتمكن من الرد لانشغالي

الحمدلله أنه يوجد من الأخوة الأعزاء من يسد الفراغ

شكرا لك أخ ياسر للمساعدة

تحياتي للجميع

شكرا لك اخى واستاذى ابو عيد

اذا اتاح لك الوقت يرجى الاطلاع ع هذا الموضوع

كود تعديل وحفظ على ما سبق حفظه

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