محتاج كود تجميع رصيد العهدة

[ehabaf2]

الاخوة الافاضل 

السلام عليكم الاخوة الكرام

عندى عهدة فلوس موجه لشراء اصناف معينة  بكتب اسم العهدة فى العمود   c كل مرة بستخدم العهدة بتزيد او تقل حسب الصرف او الاضافة و تجمع الرصيد الباقى فى العهدة فى العمود k

محتاج كود يجمع  الارصدة الباقية فى جميع العهد فى الخليه O5

يعني كود يجمع الرصيد اللى فى العمود k  لاخر مرة ذكرة فيها اسم العهدة مرفق ملف للتوضيح

و لكم جزيل الشكر

تجارب اجمالى العهدة.xlsx

[عبدالله بشير عبدالله]

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

جرب الملف 

الكود

Sub CalculateNetValues()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim dict As Object
    Dim key As Variant
    Dim totalValue As Double
    Dim expenseValue As Double
    Dim netValue As Double
    
    Set ws = ThisWorkbook.Sheets("Sheet1")
    lastRow = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row
    Set dict = CreateObject("Scripting.Dictionary")
    For i = 4 To lastRow
        If Not dict.exists(ws.Cells(i, "C").Value) Then
            dict.Add ws.Cells(i, "C").Value, ws.Cells(i, "D").Value
        Else
            dict(ws.Cells(i, "C").Value) = dict(ws.Cells(i, "C").Value) + ws.Cells(i, "D").Value
        End If
    Next i
    For i = 4 To lastRow
        If dict.exists(ws.Cells(i, "C").Value) Then
            If IsNumeric(ws.Cells(i, "J").Value) Then
                dict(ws.Cells(i, "C").Value) = dict(ws.Cells(i, "C").Value) - ws.Cells(i, "J").Value
            End If
        End If
    Next i
    netValue = 0
    For Each key In dict.keys
        netValue = netValue + dict(key)
    Next key
    ws.Range("O5").Value = netValue
End Sub

الملف

تجارب اجمالى العهدة.xlsb

[محمد هشام.]

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

   ادا كنت تقصد انك ترغب بجمع  القيمة الإجمالية في العمود "K" التي تتوافق مع القيم الفريدة في العمود "C"  إليك اقتراح اخر بطريقة مختصرة  

 

Sub test1()
    Dim SumCel As Range
    Dim f As Worksheet, Irow As Long, r As Long
    Dim dict As Object, n As Double, tmp As String
    Set f = ThisWorkbook.Sheets("Sheet1")
    Irow = f.Cells(f.Rows.Count, "C").End(xlUp).Row
    Set SumCel = f.[O5]
    Set dict = CreateObject("Scripting.Dictionary")
        For r = Irow To 4 Step -1
        tmp = f.Cells(r, "C").Value
        If Not dict.exists(tmp) Then
            dict.Add tmp, f.Cells(r, "K").Value
        End If
    Next r
    n = Application.Sum(dict.Items): SumCel.Value = n
End Sub

 

تجارب اجمالى العهدة V1.xlsb

تم تعديل أكتوبر 9 بواسطه محمد هشام.

[ehabaf2]

الاستاذ الفاضل @عبدالله بشير عبدالله

الاستاذ الفاضل @محمد هشام.

الف الف شكر لحضراتكم الكود في الحالتين يعمل بكفاءة و ينفذ المطلوب 

زادكم الله من علمه وفضله