اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

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

قام بنشر

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

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

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

وشكرا جدا

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