استخراج القيم الفريدة أي الغير مكررة في نطاق باستخدام الكائن القاموس

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

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

إخواني في الله

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

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

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

وهذا هو الكود مصحوب بالشرح ... أرجو أن ينال إعجايكم

Sub UniqueByDictionary()
'يقوم الكود باستخراج القيم الفريدة أي الغير مكررة باستخدام الكائن قاموس
'----------------------------------------------------------------------
    'المتغير الأول لتخزين قيم النطاق والمتغير الثاني لتخزين مفاتيح القاموس
    'الثالث متغير للكائن القاموس والرابع متغير يستخدم في عمل حلقة تكرارية
    Dim myData As Variant, Temp As Variant
    Dim Obj As Object, I As Long
    
    'ليساوي الكائن المسمى القاموس والذي يعتبر أداة قوية للتعامل مع القيم الفريدة [Obj] تعيين المتغير
    Set Obj = CreateObject("Scripting.Dictionary")
    
    'ليساوي قيم النطاق في العمود الأول [myData] تعيين المتغير
    myData = Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row).Value
    
    'حلقة تكرارية تبدأ من أول عنصر في مصفوفة القيم إلى آخر عنصر في المصفوفة
    For I = 1 To UBound(myData)
        'هذا السطر هو أهم سطر في الكود حيث يتم تمرير القيمة للقاموس
        'فيقوم القاموس بتخزينها إذا كانت القيمة تصادفه لأول مرة
        'أما إذا كانت القيمة مكررة فلا يقوم بتخزينها مرة أخرى
        Obj(myData(I, 1) & "") = ""
    Next I
    
    'ليساوي مفاتيح القاموس والتي تمثل القيم الغير مكررة [Temp] تعيين المتغير
    Temp = Obj.Keys
    
    'حيث يتم تحديد عدد الصفوف [E1] وضع عناصر القاموس الغير مكررة في الخلية
    'والتي تقوم بعد عناصر القاموس التي تم تخزينها [Count] من خلال كلمة
    'عبارة عن مصفوفة بالقيم تكون على شكل أفقي لذا نستخدم [Temp] المتغير
    'لتحويل القيم من الشكل الأفقي إلى الشكل الرأسي ليناسب وضع النتائج في عمود [Transpose] كلمة
    Range("C1").Resize(Obj.Count, 1) = Application.Transpose(Temp)
End Sub

وإليكم الملف المرفق مطبق فيه الكود مع مثال بسيط

حمل الملف من هنا

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

[أبوبسمله]

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

ربنا يجعله فى ميزان حسناتك

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

وجزيت خيراً يا أخي الغالي أحمد

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

[أبوبسمله]

اخى الحبيب الغالى

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

تقبل تحياتى وتقديرى

[عبد العزيز البسكري]

بارك الله فيك يا غالي على الدّروس الهامّة و المفيدة و الشّرح البسيط ..

لم نشبّع .. و لا نشبع من علمك أبدًا

واصل و فّقك الله .. و هأنذا بصدد محاولة فهم الكود ..

تم تعديل أبريل 2, 2016 بواسطه عبد العزيز البسكري

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

أخي الغالي عبد العزيز

بارك الله فيك وجزيت خيراً ..

لكم أسعدتني كلماتك ومرورك العطر بالموضوع

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

[الصـقر]

الاخ الغالى ابوالبراء

جزاكم الله خيرا على كل ما تقدمه

تقبل تحياتى

تم تعديل أبريل 3, 2016 بواسطه الصـقر

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

أستميحكم عذراً  ...

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

[أبوبسمله]

أخى حسام

صباحك معطر بذكر الله

كن كشجرة طيبه تؤتى اكلها كل حين

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

هل ينتظر المحسن مقابل ممن يحسن عليهم

فاحسن علينا مما فضلك به الله علينا وجزاك الله خيرا

تقبل تحياتى

[الصـقر]

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

تم تعديل أبريل 3, 2016 بواسطه الصـقر

[محي الدين ابو البشر]

السلام عليكم

اشتاذا ياسر زاد الله في علمك وجزالك خل خير وسر خاطرك وأنالك ثواياً عظيما

لي رجاء 

لا تتوقف عن المواضيع الجديدة 

بارك الله بك

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

أستميحكم عذراً  ...

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

[Yasser Fathi Albanna]

بارك الله فيك وأدام عليك الصحة والعافية أخى الحبيب الغالى / ياسر خليل

تقبل تحياتى

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

إخواني الكرام

أعتذر عن ردي الأول في الموضوع .. أنا كنت أمزح ولا شيء آخر ..صحيح متضايق من قلة التفاعل في الموضوعات ، ولكن هذا لن يمنعني إن شاء الله من السير قدماً ، لربما يأتي من بعدنا من يستفيدون بهذا العلم ويفيدون غيرهم

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

وأنا لا أنتظر الشكر من الناس ..كلا والله .. فإني آمل الأجر من الله قبل أي شيء آخر ..

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

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

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

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

[الصـقر]

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

 

تم تعديل أبريل 3, 2016 بواسطه الصـقر

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

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

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

ولن أطيل الكلام ولا أريد أية مناقشات غير مجدية في الأمر .. فليكن نقاشنا وتركيزنا في التعلم وفي الموضوعات التي تطرح ..

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

[محي الدين ابو البشر]

السلام عليكم

في محاولتي لفهم الموضوع وتطبيقه عملياً

حصل معي تداخل مع دروس المصفوفات: في السطر:

myData = sheet.Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row).Value

تم وضع القيم في القيم في  المصفوفة myData

ما احاول عمله هو إضافة قائمة أخرى من sheet آخر أو اكثر إلى المصفوفة myData ليتم المطلوب على اكثر من قائمة في اكثر من sheet

أو كيف نجعل 

Dictionary

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

امر آخر:

في نفس السطر .value. لم أعرف اهميتها

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

 وضعت معادلة في نفس العمود  وبعد تنفيذ الماكرو نقل المعادلة كـ قيمة وليس كمعادلة

أرجو الإفادة ودمتم ذخراً

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

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

لإضافة أوزراق عمل أخرى أو إضافة قيم جديد للمصفوفة الموجودة بالفعل .. أولاً لابد من عمل حلقة تكرارية لأوراق العمل المراد التعامل معها ثم تخزين القيم الجديدة في نفس المصفوفة قبل استخدام الكائن القاموس .. ويتم استخدام كلمة ReDim Preserve قبل تحديد أبعاد المصفوفة من جديد ، حتى يمكن للقيم الجديدة أن تدرج ، و في نهاية المطاف يتم التعامل معها مرة واحدة من خلال الكائن القاموس ..

[الصـقر]

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

تم تعديل أبريل 3, 2016 بواسطه الصـقر

[محي الدين ابو البشر]

9 دقائق مضت, ياسر خليل أبو البراء said:

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

لإضافة أوزراق عمل أخرى أو إضافة قيم جديد للمصفوفة الموجودة بالفعل .. أولاً لابد من عمل حلقة تكرارية لأوراق العمل المراد التعامل معها ثم تخزين القيم الجديدة في نفس المصفوفة قبل استخدام الكائن القاموس .. ويتم استخدام كلمة ReDim Preserve قبل تحديد أبعاد المصفوفة من جديد ، حتى يمكن للقيم الجديدة أن تدرج ، و في نهاية المطاف يتم التعامل معها مرة واحدة من خلال الكائن القاموس ..

السلام عليم

بارك الله بك استاذ ياسر

سأعمل على الموضوع وساعود إليك إذا مش ولا بد

 

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

أخي الحبيب حسام عيسى

ما زلت عند قولي أني متضايق من قلة التفاعل فأنا لم أنكر قولي .. ولكن لا أريد مناقشات كما ذكرت تضيع الوقت ولا تجدي ..

ولن أحذف المشاركات لأن ذلك يحزن الأعضاء ، فدع النقاش ولكن يجب أن نضع نهايةً له حيث لا جدوى منه وربما يأتي بعواقب غير محمودة

 

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

تقبل تحياتي (ومتزعلش يا حوسو وآدي راسك أبوسها )

 

[الصـقر]

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

تم تعديل أبريل 3, 2016 بواسطه الصـقر

[أبوبسمله]

اخى فى الله حسام 

حاسس انك زعلان منى ووالله انا لم اقصد اى شىء غير انه حتى لو لم يتم التفاعل من الاعضاء فلا يؤثر على من يقوم بالرد عليهم بالحل او موضوع تعليمى فهو ينتظر الجزاء من الله وإلا لن يكلف نفسه عناء الجلوس لكتابة موضوع او رد على استفسار 

فارجو منك مسامحتى ان كنت زعلتك بغير قصد

وانا اخوك الصغير

واعتذر منك ومن ابوالبراء ومن جميع الاساتذه والاخوان الافاضل

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

تقبلوا تحياتى واحترامى واعتذارى

[الصـقر]

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

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

 

[أبوبسمله]

ربنا يعزك ويجازيك كل خير 

ونعوذ بالله العلى العظيم من كل شيطان رجيم

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

تحياتى وتقديرى لكم اساتذتى الكرام