اذهب الي المحتوي
أوفيسنا

عمل دالة او كود لجمع المبالغ المحصله خلال الشهر


OmHamza
إذهب إلى أفضل إجابة Solved by Ali Mohamed Ali,

الردود الموصى بها

السلام عليكم ورحمه الله

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

في الملف المرفق في مبالغ مسدده خلال فترة معين ولتكن سته اشهر انا عايزه معادله او حاجه تجمع تحصيل كل شهر لوحده كما في النموذج المرفق

وشكرا جدا

SUM.xlsm

رابط هذا التعليق
شارك

بعد اذن اساتذتي الكرام و لاثراء الموضوع  كود بالحلقات التكرارية

Sub test()
Dim lr1, lr2
Dim x, x2
Dim tot
tot = 0
Application.ScreenUpdating = False
With Sheets("Sheet1")
lr1 = .Cells(Rows.Count, 1).End(3).Row
lr2 = .Cells(Rows.Count, "i").End(3).Row
For x2 = 2 To lr2
For x = 2 To lr1
If Format(.Cells(x2, "i"), "mm-yyyy") = Format(.Cells(x, 1), "mm-yyyy") Then
tot = tot + .Cells(x, 2)
End If
Next x
.Cells(x2, "j") = tot
tot = 0
Next x2
End With
Application.ScreenUpdating = True
End Sub

SUM_2.xlsm

  • Like 1
رابط هذا التعليق
شارك

رائع استاذ حسين و لكن ما رأيك بهذا الكود (بدون أعمدة مساعدة) وحلقة تكرارية واحدة

 Sub Find_sum()
 Dim i As Long, a, b
 Dim Dic As Object
 Dim sh As Worksheet
 Set sh = Sheets("sheet1")
sh.Range("J2").CurrentRegion.ClearContents
    a = sh.Cells(Rows.Count, 1).End(3).Row
   Set Dic = CreateObject("Scripting.Dictionary")
     For i = 2 To a
        If IsDate(sh.Cells(i, 1)) Then
          Dic(Format(sh.Cells(i, 1), "mmm")) = _
          Dic(Format(sh.Cells(i, 1), "mmm")) + Val(sh.Cells(i, 2))
        End If
     Next i

If Dic.Count Then
 sh.Range("J2").Resize(Dic.Count) = _
 Application.Transpose(Dic.keys)
 
 sh.Range("k2").Resize(Dic.Count) = _
 Application.Transpose(Dic.Items)
 End If
 Set Dic = Nothing
End Sub

 

  • Like 2
رابط هذا التعليق
شارك

ماشاء الله 

بشكر حضراتك جدا على المجهود الرائع والحلول الجميلة جدا جدا

بجد متشكرة جدا لحضراتكم واسفه لازعاجكم وفعلا جزاكم الله كل الخير

  • Like 1
رابط هذا التعليق
شارك

زائر
هذا الموضوع مغلق.
  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information