جمع خلايا الاسماء المتشابه

[ابو طيبه]

السلام عليكم عندي ملف يحتوي الف اسم بي اسماء بعمود a مكرر وبي بعمود b مبالغ اريد طريقة اجمع المبلغ التابع للاسم المتكرر مع مسح الصف المتكرر ليبقى اسم واحد ويقابله مجموع المبالغ لنفس الاسم

[أبوعيد]

وعليكم السلام : الطريقة من خطوتين :

الخطوة الأولى : أن ترسل نموذج من الملف لأنه لا يمكن التخمين على شيء غير موجود

لا بد أن نعرف في أي عمود تتواجد الأسماء وهل تم إدخالها يدويا أم عن طريق قائمة منسدلة أم ... أم , والمبالغ في أي عمود ؟؟؟؟؟؟

كل هذه تساؤلات لا يمكن العمل معها

الخطوة الثانية : إذا تم إزالة كل المشاكل سيتم بناء كود يحسب مطلوبك

تقبل تحياتي , و مبارك عليك الشهر (رمضان1446هـ)

تم تعديل السبت at 10:34 بواسطه أبوعيد

[ابو طيبه]

توضيح في الملف المرفق مع جزيل الشكر

جمع اقساط للاسماء المتشابهة.xlsx

[أبوعيد]

اضغط على زر النتيجة الأحمر ولاحظ النتيجة

تفضل

جمع اقساط.xlsm

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

جمع اقساط للاسماء المتشابهة.xlsm

[ابو طيبه]

 شكرا جزيلا لكم سوف اجرب الملف غدا صباحا تحياتي لكم

[محمد هشام.]

وعليكم السلام ورحمة الله تعاى وبركاته 

اقتراح اخر   

Option Explicit
Sub test()
    Dim lastRow, i As Long, OnRng, tmp, key As Variant
    Dim name As String, amount As Double, dict As Object
    Dim WS As Worksheet: Set WS = Sheets("ورقة1")
    
    With WS
        lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        If lastRow < 2 Then Exit Sub
           Set dict = CreateObject("Scripting.Dictionary"): OnRng = .Range("B2:C" & lastRow).Value
        For i = 1 To UBound(OnRng, 1)
           name = Trim(OnRng(i, 1)): amount = OnRng(i, 2): If name <> "" Then dict(name) = dict(name) + amount
        
        Next i
        
        Application.ScreenUpdating = False
        .Range("E2:F" & lastRow).ClearContents
        
        If dict.Count = 0 Then: Exit Sub
        ReDim tmp(1 To dict.Count, 1 To 2)
        i = 1
        For Each key In dict.keys
            tmp(i, 1) = key: tmp(i, 2) = dict(key): i = i + 1
        Next key
        .Range("E2").Resize(dict.Count, 2).Value = tmp
        Application.ScreenUpdating = True
    End With
End Sub

 

تم تعديل منذ 15 ساعات بواسطه محمد هشام.

[ابو طيبه]

عاشت ايدكم وبارك الله بجهودكم الله يجعلها بميزان حسناتكم

تحياتي