درج مجموع الملاحظات حسب الرقم

[alihgrvdad123]

السلام عليكم ..ممكن درج مجموع الملاحظات حسب الرقم في خلية واحدة

درج الملاحظات.xlsx

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

عليكم السلام

ربما

Sub test()
    Dim a As Variant, lr, i, x, s, k, itm
    a = Sheets(1).Range("B2:B" & Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row).Resize(, 3)
    With CreateObject("scripting.dictionary")
        For i = 1 To UBound(a)
            If a(i, 1) <> 0 Then
                If Not .exists(a(i, 1)) Then
                    .Add a(i, 1), a(i, 3)
                Else
                If a(i, 3) <> "" Then .Item(a(i, 1)) = IIf(.Item(a(i, 1)) <> "", .Item(a(i, 1)) & "+" & a(i, 3), IIf(a(i, 3) <> "", a(i, 3), ""))
                End If
            End If
        Next
        itm = .items
         Sheets(2).Cells(2, 1).Resize(.Count, 2) = Application.Transpose(Application.Index(Array(.keys, .items), 0, 0))
    End With
End Sub

 

[alihgrvdad123]

جزيت خيرا

تمام