تجميع خانات متشابهه

[SAMASEMOZ]

تجميع خانات  و ممكن طريقه لتجميع الخانات المتشابهه اكون شاكر جدا

يعني اجمع مثلا كل ال BG054  في خانه واحده ومجموع الارقام في خانه  وكل الاكواد كده  

كل كود لوحده واجمالي القطع بتاعتهم 

شكرا 

توضيح اكثر  يعني المعادله تعملي كده

bg045     7

bg 054   26

 

1.xlsx

[souchel]

الحل

1.xlsx

[SAMASEMOZ]

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

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

يمكنك استعمال هذا الماكرو ولا حاجة لاشغال البرنامج بأكثر من 1300 معادلة  SumIf

Option Explicit
Sub Find_all()
Dim S As Worksheet
Dim D As Object
Dim Ro%, k%
Set S = Sheets("sheet1")
Set D = CreateObject("Scripting.Dictionary")
S.Range("h2").CurrentRegion.Offset(1).ClearContents
Ro = S.Cells(Rows.Count, 1).End(3).Row
 With D
 k = 2
Do Until k = Ro + 1
   If S.Range("A" & k) <> vbNullString Then
      If Not D.exists(S.Range("A" & k).Value) Then
        D.Add (S.Range("A" & k).Value), _
        IIf(IsNumeric(S.Range("B" & k).Value), S.Range("B" & k).Value, 0)
      Else
        D(S.Range("A" & k).Value) = D(S.Range("A" & k).Value) + _
        IIf(IsNumeric(S.Range("B" & k).Value), S.Range("B" & k).Value, 0)
     End If
   End If
  k = k + 1
  
Loop

  Cells(2, "H").Resize(.Count - 1) = _
  Application.Transpose(.keys)
  Cells(2, "I").Resize(.Count - 1) = _
  Application.Transpose(.Items)
  Cells(2, "j") = .Count - 1
  .RemoveAll
 End With
 Set D = Nothing: Set S = Nothing
End Sub

الملف مرفق

Sum Of Unique.xlsm