هل بالامكان كود وليس معادلة الجمع بين تاريخين مع التقيد بالاسم

[زوهير]

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

هل بالامكان كود يجمع بين تاريخين مع التقيد بالاسم

والمرفق يوضح ذلك

وجزاكم الله خيرا

مثال حساب بين تارخيين.rar

[زوهير]

لرفع جزاكم الله خيرا

مستعجل مع كل احترماتي

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

السلام عليكم

عملت دالة للجمع بين تاريخين وبشرط

للاستخدام بالكود

Option Explicit


Function kh_SumIf(Rng As Range, Gri As String, GriColumn As Integer, dt1 As Range, dt2 As Range, DateColumn As Integer, SumColumn As Integer)

Dim MyValSum#, R%

With Rng

	For R = 1 To .Rows.Count

		If CStr(.Cells(R, GriColumn)) = Gri Then

		Select Case .Cells(R, DateColumn).Value2

			Case dt1.Value2 To dt2.Value2

				MyValSum = MyValSum + Val(.Cells(R, SumColumn))

		End Select

		End If

	Next

End With

kh_SumIf = MyValSum

End Function

تفضل المرفق 2003

مثال حساب بين تارخيين.rar

[عبدالله المجرب]

السلام عليكم

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

دالة معرفة قمة في الروعة ولا نملك الا الدعاء لك بالتوفيق

==

اثراء للموضوع ومن باب تعدد الحلول

هذا الكود يوضع في حدث الورقة (لاحاجة الى دالة معرفة)

Private Sub Worksheet_Change(ByVal Target As Range)

Dim cl As Range

If Not Intersect(Target, Range("C12,D12,E13")) Is Nothing Then

For Each cl In [A1:A10]

If cl.Value = [E13] And cl.Offset(0, 2) <= [C12] And cl.Offset(0, 2) >= [D12] Then

R = R + Val(cl.Offset(0, 1))

End If

Next

[C13] = R

End If

End Sub

شاهد المرفق

مثال حساب بين تارخيين.rar

[بن علية حاجي]

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

إخواني الكرام، بعض التعديلات على كود أخي الكريم عبد الله باقشير وجعله في حدث الورقة...

Private Sub Worksheet_Change(ByVal Target As Range)

Set Rng = [Base]

MySum = 0

With Rng

    For R = 1 To .Rows.Count

	    If CStr(.Cells(R, 1)) = [Search_N] Then

		    Select Case .Cells(R, 3)

			    Case [From1] To [To1]

			    MySum = MySum + Val(.Cells(R, 2))

		    End Select

	    End If

    Next

End With

    [E3] = MySum

End Sub

مع تسميات لخلايا ونطاقات البحث... وإضافة حل بمعادلة مع الدالة SUMPRODUCT (وهي معادلة واحدة ولا تؤثر في حجم الملف ولا في سرعة تنفيذه)...

أخوكم بن علية

مثال حساب بين تارخيين3.rar

[زوهير]

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

اولا وقبل كل شيء اعذروني على الاطالة في الرد

ثانيا يعجز اللسان عن الكلمات التي تستوفي مجهودكم وتلبيتكم للطلبات

ثالثا بارك الله فيكم جميعا وزادكم الله علما ووقاكم شر الفتن

رابعا من كم الاكواد المطروحة في الموضوع اقسم اني عجزت ما اقول لكم كلمة الشكر لا تكفي

لكن اقول لكم جزاكم الله خير الجزاء

وسأقوم بتجربة الاكواد كل على حدى واطلعكم الجواب بأذن الله

[زوهير]

بعد نقل الكود الى الشيت الذي اريد العمل عليه

قمت ببعض التعديلات على الكود لكن لم انجح

لاني اريد نقل البينات من شيت اخر

وسارفق لكم الملف للتعديل

test4.rar

[عبدالله المجرب]

السلام عليكم

ضع هذا الفكود في حدث ورقة العمل sie

Private Sub Worksheet_Change(ByVal Target As Range)

Dim cl As Range

Set MySh = Sheets("off")

If Not Intersect(Target, [A6:C6]) Is Nothing Then

For Each cl In MySh.[B2:B10]

If cl.Value = [A6] And cl.Offset(0, 2) <= [C6] And cl.Offset(0, 2) >= [B6] Then

R = R + Val(cl.Offset(0, 1))

End If

Next

[D6] = R

End If

End Sub

[بن علية حاجي]

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

أخي الكريم، تم تطبيق الكود الذي وضعته في ردي بالأعلى على الملف الذي أرفقته مع بعض التعديلات والتسميات على النطاقات وخلايا البحث والشروط...

أخوك بن علية

test4.rar

[زوهير]

جزاكم الله خير الجزاء وزادكم علما ونفعا للمسلمين

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

وتقبلوا مني كل اعتذراتي على تاخر في الرد للظروف العمل

واقول لكم الكود اتى بكل ماريده منه وهذا بفضلكم جميعا بما من الله عليكم من علم

[هشام مرسي]

بسم الله الرحمن الرحيم

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

مرفق حل بإستخدام المعادلات فقط

وهذا طبعا أفضل من أستخادم الكوم

test5.rar

test5.rar

تم تعديل مارس 21, 2012 بواسطه هشام مرسي

[محمود ربيع]

الاخ الكريم عبد الله باقشير السلام عليكم ورحمة الله وبركاته

اسعد الله اوقاتك بكل خير

لي استفسار عنما اقوم باستخدام الدالة المعرفة تعطي خطأ value# لا اعرف ما السبب فارجو منك اخي الكريم توضيح كيفية استخدام تلك الدالة بارك الله فيك