السلام عليكم ورحمة الله وبركاته
إخواني وأحبابي في الله ...
أعود إليكم بعد طول غياب ، بموضوع دسم ومتقدم بعض الشيء ، وهو من الموضوعات المتقدمة التي لم يتطرق إليها الكثيرون في الشرح والتقديم ، وقد دفعني لهذا الموضوع طلب لأحد الأعضاء على رابط هذا الموضوع
من هنا
والموضوع هيكون عن كيفية استخراج القيم الغير مكررة من عمودين وجمع الإجمالي الخاص بيهم باستخدام كائن القاموس
** ندخل في الموضوع وإن شاء الله أحاول أبسط الموضوع على قدر استطاعتي ، والنقطة اللي مش هتكون واضحة ممكن تسألوا عليها في التعليقات (دا لو حد عبرني أصلاً وقرا الموضوع)
** المعطيات : أهم شيء في أي مشكلة إنك تتعرف على أم عطيات (متفهمنيش غلط .. دي أم عطيات ست محترمة وكيوت جداً) >> المعطيات ومعرفة المشكلة بتفاصيلها بتمثل في نظري 90 % من حل المشكلة ، لأنك بمعرفة التفاصيل هتقدر تحدد هدفك وتقدر تحط خطة لحل المشكلة
وزي ما اتعودنا الصورة أفضل من ألف كلمة .. عشان كدا أنا لونت البيانات الخام بألوان عشان تقدر تفهم المطلوب بشكل واضح
زي ما إحنا شايفين الألوان في 3 أعمدة وهي دي الأعمدة اللي عليها العين (يعني دي الأعمدة اللي من خلالها هنخرج النتائج .. ونطلع القماش منها) .. الأعمدة دي هي العمود C (العمود الثالث) - والعمود H (العمود الثامن) - والعمود M (العمود الثالث عشر)
المطلوب نستخرج القيم الغير مكررة من عمودين (اللي هما C و H ) >> والقيم اللي تطلع هتكون موجودة في كذا صف ومطلوب نجمع القيم الخاصة بيهم في العمود M
لو كلامي مش واضح ممكن تبص في الرسوم الموجودة على يمين البيانات وإنت هتفهم التفاصيل أكتر ... أسيبك كام دقيقة تبص في الرسومات بس متسرحش كتير يا بهير
** بعد ما اتعرفنا على أم عطيات ، نتعرف على
المخرجات (النتايج المطلوبة هيكون شكلها عامل إزاي) >> اختصاراً للوقت آدي النتايج في صورة
** بعد ما اتعرفنا على المعطيات والمخرجات نبدأ في وضع
استراتيجة للحل .. أول شيء ممكن تفكر فيه لما تسمع كلمة قيم غير مكررة (قيم فريدة) ييجي في دماغك الكائن (القاموس) أو اللي اسمه بالإنجليزي Dictionary
[بالمناسبة فريدة دي تبقا مرات عم خالة الست أم عطيات اللي اتكلمنا عليها من بدري ، بس أنا مش بحب أتكلم على حد ودا واضح جداً زي ما إنتو شايفين]
القيم الفريدة المطلوب استخراجها يا مستر إسلام موجودة في عمودين مش عمود واحد (مفيش مشكلة على الإطلاق .. يبقا التفكير يقولك إنك تخزن القيم الموجودة في العمودين في متغير واحد) .. ولو كانت القيم المطلوب استخراجها بدون تكرار في 3 أعمدة أو أكتر هتكون نفس الفكرة موجودة ...
يعني تخزن القيم المطلوبة في الأعمدة دي في متغير واحد بس عشان تقدر تتعامل معاه
بالمثال يتضح المثال : لما نبص على القيمة 500 في العمود التالت ، ونبص على القيمة A في العمود التامن هنلاقي القيم دي اتكررت كام مرة ؟ (بص وارجع تاني) >> الإجابة : اتكررت 3 مرات ، إحنا بقا مع وجود الكائن المسمى القاموس ده هنخزن القيمة دي مرة واحدة وبس ..
طيب والخطوة التالية إننا نجمع العمود رقم 13 في كل مرة نعدي على نفس القيم المتكررة دي ، فيكون الناتج في المثال ده هو 10 + 15 + 2 يعني الإجمالي يساوي 27
-- دا كان مثال واحد بس عشان نفهم استراتيجية العمل
**
آخر حاجة هتعملها يا بطل إنك تبدأ في صياغة الأكواد ، وأسيبكم تسرحوا مع الكود بالشرح المفصل الممل (وأنا عارف إن مفيش حد هيقرا الشرح .. بس أديني بعمل اللي عليا والله المستعان)
الكود يوضع في موديول عادي ، والنتائج هتكون في ورقة العمل الثانية بدايةً من الخلية C2 ...
CODE
Sub Unique_In_Two_Columns_SUM_Total_By_Dictionary_Tutorial()
'متغير لورقة العمل التي تحتوي على البيانات الخام
Dim ws As Worksheet
'متغير لورقة العمل التي ستوضع فيها النتائج
Dim sh As Worksheet
'كائن القاموس يستخدم لاستخراج القيم الفريدة
Dim dic As Object
'متغير يحمل مصفوفة البيانات
Dim a As Variant
'متغير نصي للقيم المطلوب اختبار ما إذا كانت مكررة أو لا
Dim s As String
'متغير يستخدم في الحلقة التكرارية لصفوف مصفوفة البيانات
Dim i As Long
'--------------------------------------------------------------------------------
'[Sheet1] ليساوي ورقة العمل المسماة [ws] تعيين قيمة للمتغير
Set ws = ThisWorkbook.Sheets("Sheet1")
'[Sheet2] ليساوي ورقة العمل المسماة [sh] تعيين قيمة للمتغير
Set sh = ThisWorkbook.Sheets("Sheet2")
'وإنشاء كائن القاموس والذي يفيد في استخراج القيم الفريدة [dic] تعيين قيمة للمتغير
Set dic = CreateObject("scripting.dictionary")
'ليتم تخزين البيانات في النطاق المذكور داخل مصفوفة [a] تعيين قيمة للمتغير
'[M] وينتهي عند آخر خلية في العمود [A2] والنطاق يبدأ من الخلية
'والرقم 3 يمثل رقم آخر صف في العمود الثالث أو يمكن الاعتماد على أي عمود
a = ws.Range("A2:M" & ws.Cells(Rows.Count, 3).End(xlUp).Row).Value
'--------------------------------------------------------------------------------
'حلقة تكرارية من أول صف داخل مصفوفة البيانات لآخر صف داخلها
For i = LBound(a, 1) To UBound(a, 1)
'[Tab] تخزين القيمة في العمود الثالث والعمود الثامن داخل المصفوفة وبينها
'أو أي فاصل بينهما وذلك للتمييز فقط ، وهذين العمودين مطلوب استخراج القيم
'[500 A] الفريدة أو الغير مكررة لهما - على سبيل المثال
s = a(i, 3) & vbTab & a(i, 8)
'موجودة داخل عناصر القاموس أو غير موجودة [s] معرفة ما إذا كانت قيمة المتغير
'وذلك للتعامل مع القيم الفريدة أو الغير مكررة فقط
'إذا كان العنصر غير موجود في القاموس من قبل يتم إنشاء سطر له داخل القاموس
'وفي هذا السطر سيتم تخزين النتائج داخل مصفوفة أحادية مكونة من 3 أجزاء
'والثلاثة أجزاء هي عدد الأعمدة المطلوبة للشكل النهائي للنتيجة المرجوة
'الجزء الأول سيكون مخصص للعمود الثالث ، والجزء الثاني مخصص للعمود الثامن
'أما الجزء الثالث سيكون حاصل جمع القيم الموجودة في العمود الثالث عشر
'وبما أن هذا الجزء في أول مرة يكون فارغ وضعت القيمة صفر
If Not dic.Exists(s) Then dic(s) = Array(, , 0)
'في هذا السطر يتم تعبئة المصفوفة الأحادية التي شرحنا أجزائها
'حيث في الجزء الأول يتم وضع قيمة العمود الثالث داخل المصفوفة
'وفي الجزء الثاني يتم وضع قيمة العمود الثامن داخل المصفوفة
'وفي الجزء الثالث يتم جمع قيمة العمود الثالث عشر مضافاً للقيمة
'الموجودة مسبقاً في القاموس ، وعلى سبيل المثال في أول مرة يكون
'الجزء الثالث في المصفوفة الأحادية يساوي صفر ثم يضاف إليه
'القيمة الموجودة في العمود الثالث عشر ، وعندما يتكرر نفس
'العنصر مرة أخرى يتم إضافة القيمة الموجودة في العمود الثالث عشر
'مضافاً إليها القيمة السابقة التي تم تخزينها من قبل
'يمثل الجزء الثالث داخل المصفوفة الأحادية [dic(s)(2)] والرقم 2 في هذا الجزء
'حيث أن المصفوفة الأحادية تبدأ رقم الفهرس بصفر لذا رقم الفهرس 2 يعبر عن
'الجزء رقم 3 داخل المصفوفة الأحادية
dic(s) = Array(a(i, 3), a(i, 8), dic(s)(2) + a(i, 13))
'الانتقال للصف التالي داخل مصفوفة البيانات
Next i
'في ورقة النتائج توضع عناوين للنتائج للأعمدة الثلاثة
sh.Range("C1").Resize(1, 3).Value = Array("Dia", "Section Depth Type", "L Install Pipe")
'بامتداد عدد عناصر القاموس وهي [C2] وأخيراً في ورقة النتائج في الخلية
'تمثل عدد العناصر الغير مكررة وهذا الجزء سيمثل عدد الصفوف للنتائج
'وبامتداد ثلاثة أعمدة أي ستكون النتائج في ثلاثة أعمدة
'مرتين لضبط النتائج بحيث تظهر بشكل منضبط [Transpose] تم استخدام الدالة
'ثم توضع العناصر الموجودة داخل القاموس في ورقة العمل
sh.Range("C2").Resize(dic.Count, 3).Value = Application.Transpose(Application.Transpose(dic.items))
End Sub
ر ابط الملف من هنا
كان معكم أخوكم / ياسر خليل أبو البراء ، من منتدى أكاديمية الصقر للتدريب ، من على قهوة أم عطيات (الحقيني بواحد شاي في الخمسينة أحااااااااااااجة )
وفقني الله وإياكم لكل خير
والسلام عليكم ورحمة الله وبركاته