استخراج اسم المنتج من أكثر من Range بدون تكرار

[Mostafa Moawad]

مرفق شيت يحتوي على 3 جداول بكل جدول عمود لاسم المنتج وعمود للمبيعات والمطلوب عمل عمود واحد من الاعمده الثلاثه به اسماء المنتجات بدون تكرار وتكون المبيعات بعمود اخر ومرتبه من الاكبر للاصغر

  

Master.xlsx

[سليم حاصبيا]

جرب هذا الكود

Option Explicit

Sub Get_aLL()
Dim Rg_A As Range
Dim Rg_D As Range, Rg_G As Range
Dim a%, d%, g%, X%
Dim St1$, St2$
Dim Dic As Object
Range("k3").CurrentRegion.ClearContents
Set Rg_A = Range("A3", Range("A2").End(4))
Set Rg_D = Range("D3", Range("D2").End(4))
Set Rg_G = Range("G3", Range("G2").End(4))
a = Rg_A.Rows.Count: d = Rg_D.Rows.Count
g = Rg_A.Rows.Count
St1 = "All Products": St2 = "All Volume"
Set Dic = CreateObject("Scripting.dictionary")

 For X = 3 To a - 2
 If Not Dic.exists(Cells(X, 1).Value) Then
   Dic(Cells(X, 1).Value) = Cells(X, 2)
 Else
   Dic(Cells(X, 1).Value) = Dic(Cells(X, 1).Value) + Cells(X, 2)
 End If
 Next
 '+++++++++++++++++++++++++
 For X = 3 To d - 2
 If Not Dic.exists(Cells(X, 1).Value) Then
   Dic(Cells(X, 4).Value) = Cells(X, 5)
 Else
   Dic(Cells(X, 4).Value) = Dic(Cells(X, 4).Value) + Cells(X, 5)
 End If
 Next
 
 '+++++++++++++++++++++++++
 For X = 3 To g - 2
 If Not Dic.exists(Cells(X, 7).Value) Then
   Dic(Cells(X, 7).Value) = Cells(X, 8)
 Else
   Dic(Cells(X, 7).Value) = Dic(Cells(X, 7).Value) + Cells(X, 8)
 End If
 Next
 
 '++++++++++++++++++++
 
 Range("k3").Resize(Dic.Count) = _
 Application.Transpose(Dic.keys)
 
 Range("L3").Resize(Dic.Count) = _
 Application.Transpose(Dic.Items)
 
 Range("k2") = St1: Range("l2") = St2

 Range("k2").CurrentRegion.Sort Key1:=Range("L2") _
 , order1:=2, Header:=1
End Sub

الملف مرفق

Master.xlsm

[abouelhassan]

تسلم ايدك استاذنا

[saad abed]

استاذى الفاضل سليم

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

اكاد افهم اليه الكود باستثناء طريقة الجمع فى الكود

ما افهمه من الكود الاعلان عن المتغيرات

Dim Rg_A As Range
Dim Rg_D As Range, Rg_G As Range
Dim a%, d%, g%, X%
Dim St1$, St2$
Dim Dic As Object

ثم مسح مكان استدعاء البيانات

Range("k3").CurrentRegion.ClearContents

ثم تعيين المتغيرات وتعريفها

Set Rg_A = Range("A3", Range("A2").End(4))
Set Rg_D = Range("D3", Range("D2").End(4))
Set Rg_G = Range("G3", Range("G2").End(4))
a = Rg_A.Rows.Count: d = Rg_D.Rows.Count
g = Rg_G.Rows.Count
St1 = "All Products": St2 = "All Volume"
Set Dic = CreateObject("Scripting.dictionary")

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

For X = 3 To a - 2
 If Not Dic.exists(Cells(X, 1).Value) Then
   Dic(Cells(X, 1).Value) = Cells(X, 2)
 Else
   Dic(Cells(X, 1).Value) = Dic(Cells(X, 1).Value) + Cells(X, 2)
 End If
 Next

ما افهمه من الحلقه التكراريه اذا لم تجد عنصر الكائن اى عدم تكراره فى الرنج فانه يساوى cells(x,2 والا اللى انا فهمه اجمع العنصر بالرقم المجاور

ارجو شرح هذه الجزئية

اشكرك

الباقى واضح

تم تعديل أغسطس 29, 2020 بواسطه saad abed

[سليم حاصبيا]

1- في هذا القسم من الكود تم استعمال حاصية الـــ Dictionery  التي لا تسمح لتكرار البيانات داخلها
    الـــ Dictionery  يضيف الى بياناته نوعين من العناصر   Key   و   Items   الـــ  Key  لا يمكن ان يتكرر 

2- انا أقول للـ   Dictionery  في هذا القسم
  اذا كانت الحلية   (  Cells(X, 1    غيرموجودة     عتدك  خذها  لتمثل دور الـــ  Key    والخلية  التي الى جانبها   (  Cells(X, 2)   تمثل الـــ__ ( Item)
 و اذا كانت موجودة   Key  اجمع الى ما   يتبعها  (  Cells(X, 2)  ليمثل المجموع دور    Items  (في هذه الحالة وجدنا Items 
    جديدة   لهذا الــ  Key الذي هو  (  Cells(X, 1 

على كل حال يمكن استبدال هذه الجزئية من الكود بهذه

For X = 3 To a - 2
   Dic(Cells(X, 1).Value) = _
   Dic(Cells(X, 1).Value) + _
   IIf(IsNumeric(Cells(X, 2).Value), Cells(X, 2).Value, 0)
 Next

 

[saad abed]

استاذ سليم

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

واكتملت الفكره

اشكرك

اشكرك