تعديل في الأكواد (تعبئة الكومبو بقيم فريدة باستخدام Scripting.Dictionary)

[أحمد علي (أبوعلي)]

أخواني الأعزاء...

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

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

وأشكركم على جهودكم ومساعداتكم..

أخواني ...

إذا أمكن عمل القوائمة المنسدلة على الفورم الموجود داخل الملف المرفق والشرح المطلوب داخل الملف..

bjn3000_1.rar

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

أخي الكريم

يرجى تغيير اسم الظهور للغة العربية

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

[أحمد علي (أبوعلي)]

أستاذي الفاضل..

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

بالنسبة للمبلغ الكلي بعد التأكد من اسم الحساب ورقم القيد يقوم باستدعاء القيمة من عمود المدين

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

وتم ارسال الملف بعد التعديل في صفحة اليومية عمودين المدين والدائن

يرجى العمل على هذا الملف

bjn3000_1.rar

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

ممكن ترفق  مثال بالنتائج المتوقعة (اضرب مثال) واعذرني لجهلي بمجال عملك كمحاسب

[أحمد علي (أبوعلي)]

أخي الأستاذ ياسر

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

رسلت لك المثال مع شرح المطلوب (الشرح داخل المرفق)

 

bjn3000_2.rar

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

أخي الكريم

لم تستجب لمطلبي بتغيير اسمك  للغة العربية .. ورغم عدم استجابتك لمطلبي إلا أنني استجبت لمطلبك

إليك الملف التالي ..قم بالإطلاع عليه وموافاتنا بأية ملاحظات ..

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

تقبل توجيهاتي وتحياتي

Add Unique Items In ComboBoxes YasserKhalil.rar

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

أخي الكريم

لم تستجب لمطلبي بتغيير اسمك  للغة العربية .. ورغم عدم استجابتك لمطلبي إلا أنني استجبت لمطلبك

إليك الملف التالي ..قم بالإطلاع عليه وموافاتنا بأية ملاحظات ..

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

تقبل توجيهاتي وتحياتي

Add Unique Items In ComboBoxes YasserKhalil.rar

اخى ياسر

ايه الجمال والحلاوه دى

اكواد جميله

بارك الله فيك

ولكن

ياريت لو تشرح الاكواد

لاننى تقريبا

عارف ازاى اطبقها

بس للاسف مش فاهم معناها

تقبل تحياتى

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

أخي الغالي إبراهيم أبو ليلة ..

مشكور على مرورك العطر بالموضوع وعلى تشجيعك الدائم لي

حدد الجزء الذي تريد شرحه لأن الكود فيه أجزاء كثيرة ..حاول تتعرف على الكود وشوف الأجزاء الصعبة وإن شاء الله نحاول نشرحها

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

أخي الغالي إبراهيم أبو ليلة ..

مشكور على مرورك العطر بالموضوع وعلى تشجيعك الدائم لي

حدد الجزء الذي تريد شرحه لأن الكود فيه أجزاء كثيرة ..حاول تتعرف على الكود وشوف الأجزاء الصعبة وإن شاء الله نحاول نشرحها

يابشا اشرح

فكره استخدام

CreateObject

تقبل تحياتى

 

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

فكرة استخدامها بشكل أساسي هو الاحتفاظ بالقيم الفريدة أي الغير مكررة فقط ...

كيفية استخدامها : هناخد الكود الخاص بحدث بدء الفورم كمثال

Private Sub UserForm_Initialize()
    Dim Rng As Range
    Dim Dn As Range
    Dim Dic As Object
    With WS
        Set Rng = .Range(.Range("A4"), .Range("A" & Rows.Count).End(xlUp))
    End With
    Set Dic = CreateObject("Scripting.Dictionary")
    Dic.CompareMode = vbTextCompare
    For Each Dn In Rng: Dic(Dn.Value) = Empty: Next
    Me.ComboBox1.List = Application.Transpose(Dic.keys)
End Sub

مع بداية تشغيل الفورم يتم تعبئة الكومبو الأول بالقيم الفريدة من العمود الاول

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

السطر الذي يليه للتعامل مع الأحرف الحساسة (السطر يتغاضى عن حالة الأحرف ... فلو كتبنا في الخلية A32 كلمة Yasser وكتبنا في الخلية A33 كلمة yasser .... وشغلنا الفورم وشوفنا القايمة المنسدلة هتلاقي أول كلمة بس هي اللي موجودة ، وتم التغاضي عن الكلمة الأخرى أي أن حالة الأحرف غير هامة ..)

السطر التالي عبارة عن 3 أسطر وهو عبارة عن حلقة تكرارية

    For Each Dn In Rng
        Dic(Dn.Value) = Empty
    Next Dn

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

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

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

المهم كل مفتاح مميز .. يعني يحمل قيمة واحدة فقط

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

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

....

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

Range("G1").Resize(Dic.Count, 1).Value = Application.Transpose(Dic.keys)

لاحظ هنا تم استخدام كلمة Count لعد مفاتيح القاموس ..

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

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

ياعم ياسر كمل جميلك ياراجل للاخر

وقولنا ايه نظام الكود ده كمان

Sub cValues(Txt As String, Obj As Object, Col As Integer)
    Dim Dn As Range
    Dim Rng As Range
    Dim Dic As Object

    Obj.Clear
    With WS
        Set Rng = .Range(.Cells(4, Col), .Cells(Rows.Count, Col).End(xlUp))
    End With

    Set Dic = CreateObject("Scripting.Dictionary")
    Dic.CompareMode = 1

    For Each Dn In Rng
        If Dn.Offset(, -1).Value = Txt Then
            If Not Dic.exists(Dn.Value) Then
                Dic(Dn.Value) = Empty
            End If
        End If
    Next Dn
    Obj.List = Application.Transpose(Dic.keys)
End Sub

Private Sub ComboBox1_Click()
    Call cValues(ComboBox1.Value, ComboBox2, 2)
End Sub

معلش متقلين عليك

بس احنا متأكدين ان صلب

اكتر من حديد عز والدخيله

تقبل تحياتى

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

أخي الحبيب إبراهيم

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

ركز على الاستخدام الأول

شوف الجزء ده ..

Private Sub ComboBox1_Click()
    Call cValues(ComboBox1.Value, ComboBox2, 2)
End Sub

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

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

هنا فيه 3 بارامترات : الأول النص المراد البحث عنه ، والثاني الكائن (الكومبو) اللي هيتم تعبئته بالقيم الفريدة الخاصة بالنص ، والثالث رقم العمود الهدف اللي هييجي منه القيم

كما في المرفق عند اختيار مثلاً فاتورة بيع من الكومبو الأول يتم تنفيذ الإجراء وتتم عملية الاستدعاء لقيمة الكومبو الأول (فاتورة بيع) ويبدأ الكود يعبي الكومبو الثاني بناءً على القيم الغير مكررة من العمود الثاني (أسماء العملاء)

***************

نروح للإجراء الشبيه بالدالة المعرفة

تعريف المتغيرات يليه هذا السطر

Obj.Clear

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

السطر التالي

    With WS
        Set Rng = .Range(.Cells(4, Col), .Cells(Rows.Count, Col).End(xlUp))
    End With

المتغير WS لأنه مستخدم في أكتر من مكان (الخاص بتعيين ورقة العمل المسماة "اليومية") فضلت إنه يكون متغير عام Public فوضعت السطر التالي في موديول

Public WS As Worksheet

عشان كل الموديولات الموجودة تشوف المتغير وتتعامل معاه .. ولكن أين يتم تعيين المتغير ؟؟

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

Private Sub Workbook_Open()
    Set WS = Sheets("اليومية")
End Sub

أي مع فتح المصنف يتم تعيين المتغير ليساوي ورقة العمل "اليومية"

يرجع مرجوعنا لموضوعنا

Set Rng = .Range(.Cells(4, Col), .Cells(Rows.Count, Col).End(xlUp))

تعيين النطاق ليساوي العمود الهدف (البارامتر الثالث) بداية من الصف الرابع في البيانات إلى آخر صف في نفس العمود

************* أرتاح شوية ********** أصلي بتعب من الكتابة ********** (هو الجو حر ولا مصر دخلت النار .. ربنا يلطف بينا)

رجعنا Back

Set Dic = CreateObject("Scripting.Dictionary")

السطر ده شرحناه قبل كدا ..تعيين المتغير Dic من النوع كائن (ليمثل الكائن قاموس) وعرفنا فايدته لتخزين القيم الفريدة أي الغير مكررة

Dic.CompareMode = 1

السطر ده تم شرحه في المشاركة السابقة زي السطر ده (هو هو)

Dic.CompareMode = vbTextCompare

 

ننتقل لأهم جزئية ::::

    For Each Dn In Rng
        If Dn.Offset(, -1).Value = Txt Then
            If Not Dic.exists(Dn.Value) Then
                Dic(Dn.Value) = Empty
            End If
        End If
    Next Dn

الجزء ده لازم يتشرح لوكشة  واحدة لأنه حلقة تكرارية .. في كل خلية من خلايا النطاق (العمودالهدف اللي بييجي منه القيم الفريدة)

هنا القيم بتيجي مثلاً من العمود الثاني (أنا بضرب مثال تطبيقي) بناءً على العمود الأول

فبنقول كدا

If Dn.Offset(, -1).Value = Txt Then

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

 

لو تحقق الشرط وهو دا المهم يعمل ايه الكود

يبدأ ياخد قيم العمود الهدف (العمود الثاني على سبيل المثال في مثالنا) ويخزنه في القاموس

والجزء ده شرحناه في المشاركة السابقة

If Not Dic.exists(Dn.Value) Then
                Dic(Dn.Value) = Empty
            End If

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

Dic(Dn.Value) = Empty

آخر جزئية هي وضع مفاتيح القاموس في الكومبو

Obj.List = Application.Transpose(Dic.keys)

تقبلوا تحياتي

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

اخى واستاذى ياسر

والله المحترم يفضل طول عمره محترم

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

بصراحه

الموضوع كبير

وطالما استعنا بك

يبقى اكيد

هيبقى صغير

فهمناه والحمد لله

وزى ما تفضلت وقولت

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

منتظرينك تقدمهولنا

بالبساطه الى عودتنا عليها

تقبل تحياتى

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

أخي الحبيب إبراهيم

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

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

الكثير منا يحتاج تعبئة الكومبو بقيم فريدة أي غير مكررة

تقبل وافر تقديري واحترامي

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

                                                                                     

                                                                                                                                                                                                                                                                                                                                                                                               

تم تعديل أغسطس 19, 2015 بواسطه إبراهيم ابوليله

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

اخى ياسر

معلش

هتتعب معانا شويه

انت عارف ان ال مخاخ مش زى بعضها

انا بس كنت عايز اعرف

Obj.Clear

الكود ازاى عرف ان obj

دى تبقى هيا الكومو

هل تم التعرف عليها من

UserForm_Initialize

ولا الموضوع جه ازاى

كمان فيه حاجه تانيه

احنا عرفنا

Col As Integer

بس انت جيت فى السطر ده

 Set Rng = .Range(.Cells(4, Col), .Cells(Rows.Count, Col).End(xlUp))

عرفنا ان رقم 4 و عباره عن الصف الرابع فى شيت اليوميه

ولكن انا مش عارف

Col

 

اصبح يمثل انهى عمود فى شيت اليوميه

لاننى اعرف انه فى الغالب يكتب السطر بالشكل الاتى

ده لو افترضنا اننا عايزين نشير الى العمود الاول

Set Rng = .Range(.Cells(4, 1), .Cells(Rows.Count, 1).End(xlUp))

ارجو التوضيح

تقبل تحياتى

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

كل اللي بتسأل عليه موجود في سطر واحد فقط ألا وهو سطر الاستدعاء

Call cValues(ComboBox1.Value, ComboBox2, 2)

أنا قلت إن الإجراء شبه الدوال المعرفة UDF Functions .. يعني ليها بارامترات ..البارامتر الأول هنا هو النص أو الشرط وهو هنا في المثال قيمة الكومبو الأول

البارامتر الثاني هو الكائن المستهدف obj الذي نريد تعبئة بياناته

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

يا ريت تكون وضحت الصورة ..

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

اخى ياسر

مشكورا على الاهتمام والتوضيح

بصراحه انا بدأت اقتنع بان كثره المشاركات

تفيد الاعضاء اكثر من طرح الموضوع وشرحه

لانك دائما ما تلاقى استفسارات

قد تكون غائبه عن بالك

فتدركها

وحينما يجاب عليها تضاف الى معلوماتنا

ولذلك

لدى سؤالين

الاول

فى السطر

If Dn.Offset(, -1).Value = Txt 

هل المتغير txt

هو عباره عن البارامتر الاول

الثانى

انت قولت فى الشرح

انه يمكن الاستغناء عن السطور الثلاثه

       If Dn.Offset(, -1).Value = Txt Then
            If Not Dic.exists(Dn.Value) Then
                Dic(Dn.Value) = Empty

ونستبدلها بسطر واحد

   Dic(Dn.Value) = Empty

صح ولا ايه

ولكن لما انا حزفت السطرين دول

If Dn.Offset(, -1).Value = Txt Then
            If Not Dic.exists(Dn.Value) Then

لقيت ان الكوموبوكس 2

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

يتم احضار جميع الاسماء فى الكوموبوكس 2

ياريت لو توضح ما تقصده بكلامك عن حزف السطرين

وهل اذا حزفناهم فعلا سوف يؤثر فى الكود ام لا

تقبل تحياتى

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

أخي الكريم إبراهيم

السؤال الأول إجابته نعم هو البارامتر الاول (النص أو الشرط الذي يتم اختيار عناصر القائمة على أساسه)

السؤال الثاني .. كلامي صحيح والدليل الملف المرفق ..جرب الملف المرفق قمت بحذف الثلاثة سطور واكتفيت بسطر واحد فقط

دول الـ 3 سطور

If Not Dic.exists(Dn.Value) Then
                Dic(Dn.Value) = Empty
            End If

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

Add Unique Items In ComboBoxes YasserKhalil.rar

تم تعديل أغسطس 19, 2015 بواسطه ياسر خليل أبو البراء

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

اخى الفاضل ياسر

كده الرؤيه على ما اعتقد بانت

وهلال الكائن من نوع القاموس

بدأ يدخل فى حارتنا

والفضل طبعا لمستكشف الاهله

البروفوسير ياسر خليل

نسأل الله ان يزيدك من فضله وعلمه

ويديم عليك الصحه والعافيه

تقبل تحياتى

[أحمد علي (أبوعلي)]

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

كيف حال الأستاذ ياسر خليل

يوجد ملاحظات بسيطة في الفورم والشرح داخل المرفق.

وسلامي لأخي إبراهيم أبو ليلى لتداخله الحيوي (ما شاء الله تبارك الله)

كما أن لدي رغبة في تعلم (VBA)  أرجو إرشادي وجزاكم الله خير.

 

Add Unique Items In ComboBoxes YasserKhalil.rar

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

أخي الكريم أحمد علي

النقطة الأولى : عدم السماح بالكتابة في خانة المبلغ الكلي والباقي

الحل : روح للفورم نشط مربع النص "المبلغ الكلي" بعمل كليك شمال عليه وروح لنافذة الخصائص وغير قيمة الخاصية Enabled لتصبح False بدلاً من القيمة True

نفس الكلام مع مربع النص "الباقي"

************************

النقطة الثانية : في حالة خانة الباقي تساوي صفر أو لاشيء يتم عدم تنشيط زر موافق

الحل : ضع السطر التالي في حدث بدء الفورم

Private Sub UserForm_Initialize()

ضع هذا السطر في نهاية الإجراء قبل End Sub

cmdOK.Locked = True

أيضاً ضع الأسطر التالية في حدث Private Sub ComboBox3_Change()

في نهاية الإجراء قبل End Sub أيضاُ ضع التالي

    If TextBox2 = "" Or TextBox2 = 0 Then
        cmdOK.Locked = True
    Else
        cmdOK.Locked = False
    End If

***********************

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

تقبل تحياتي