معادلة بحث ودمج حسب الموجود في المرفق

[No3manovic]

لو سمحتوا مطلوب المعادلة دي وبدون استخدام اكواد vba

[الرائد77]

السلام عليكم 

كان يجب ارفاق الملف يا أخي

تفضل 

talabia.xlsx

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

بعد اذن اخي الرائد هذا الماكرو

Option Explicit

Sub Join_data()
If ActiveSheet.Name <> "Salim" Then Exit Sub
Dim i%, Dic As Object, k, my_key
Set Dic = CreateObject("Scripting.Dictionary")
Cells(3, "H").CurrentRegion.Clear
i = 3
Do Until Cells(i, "E") = vbNullString
    k = Cells(i, "F")
      If Not Dic.Exists(Cells(i, "E").Value) Then
         Dic(Cells(i, "E").Value) = k
      Else
         Dic(Cells(i, "E").Value) = Dic(Cells(i, "E").Value) & "," & k
      End If
    i = i + 1
Loop
  Cells(3, "H").Resize(Dic.Count) = Application.Transpose(Dic.keys)
i = 3
 For Each my_key In Dic.keys
  Cells(i, "I") = Dic(my_key) & "."
  i = i + 1
 Next my_key
 Set Dic = Nothing
 With Cells(3, "H").CurrentRegion
 .Interior.ColorIndex = 6
 .Borders.LineStyle = 1
 .InsertIndent 1
 End With
End Sub

الملف للمعاينة مرفق

talabia_SL.xlsm

[No3manovic]

شكرا جزيلا 

لو سمحت اخي الرائد كنت محتاج اضيف خانة تاني لإسم الطلبية في العمود G
بحيث تظهر في جدول تاني منفصل بداية من العمود AA
ممكن؟

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

ممكن ان يكون المطلوب

Option Explicit

Sub Join_data_NEW()
If ActiveSheet.Name <> "Salim" Then Exit Sub
Dim i%, Dic As Object, k, my_key, ARR
Set Dic = CreateObject("Scripting.Dictionary")
Cells(3, "H").CurrentRegion.Clear
Cells(3, "AA").CurrentRegion.Clear

i = 3
Do Until Cells(i, "E") = vbNullString
    k = Cells(i, "F")
      If Not Dic.Exists(Cells(i, "E").Value) Then
         Dic(Cells(i, "E").Value) = k
      Else
         Dic(Cells(i, "E").Value) = Dic(Cells(i, "E").Value) & "," & k
      End If
    i = i + 1
Loop
  Cells(3, "H").Resize(Dic.Count) = Application.Transpose(Dic.keys)
i = 3
 For Each my_key In Dic.keys

  Cells(i, "I") = Dic(my_key) & "."
  i = i + 1
 Next my_key
 i = 3
 '+++++++++++++++++++++++++++
 Cells(3, "AA").Resize(Dic.Count) = Application.Transpose(Dic.keys)
 For Each my_key In Dic.keys
  ARR = Split(Dic(my_key), ",")
  Cells(i, "AB").Resize(, UBound(ARR) + 1) = ARR
  i = i + 1
 Next my_key
 
 
 '+++++++++++++++++++++++++++
 Set Dic = Nothing
 With Cells(3, "H").CurrentRegion
 .Interior.ColorIndex = 6
 .Borders.LineStyle = 1
 .InsertIndent 1
 .Font.Bold = True
 End With
 Cells(3, "H").CurrentRegion.Columns(1) _
 .Interior.ColorIndex = 38
 With Cells(3, "AA").CurrentRegion.SpecialCells(2)
 .Interior.ColorIndex = 28
 .Borders.LineStyle = 1
 .InsertIndent 1
 .Font.Bold = True
 End With
 Cells(3, "AA").CurrentRegion.Columns(1) _
 .Interior.ColorIndex = 38
End Sub

الملف مرفق للمعاينة

 

talabia_SL _Plus.xlsm

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

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

[No3manovic]

السلام عليكم 

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

ملحوظة: انا عايز معادلات مش كود vba بعد اذنكوا

من فضلك لا تكرر نفس المشاركات ... والا ستحذف جميع المشاركات

talabia.xlsx

[الرائد77]

تفضل

talabia.xlsx