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

قمت بكتابة هذا الكود لاحتساب بعض القيم اعتمادا علي الفترة الزمنية ولكن لم يعمل


إذهب إلى أفضل إجابة Solved by أبو عبدالله الحلوانى,

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

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

أرجو من السادة الخبراء المساعدة في توضيح سبب عدم وجود أي مخرجات لهذه الدالة وهل يوجد سبيل لاختصارها وجزاكم الله خيرا

Function tstAmont(ByVal Amount As Double, ByVal Nsht As Integer, ByVal strtDat As Date, ByVal srf As Integer, _
                 ByVal ktr As Integer, ByVal whdat As Integer, Optional stopDat As Date = 0) As String
'this code for test amount and return correct date for
'this amount main idea will use 'for loop' to add 1 month
'to start date and calc amount if our amount = user amount
'stop her. else add another month and so on.
'======================
Dim n As Integer
Dim shozDat As Integer
Dim dats(5) As Date
Dim prsHom(5) As Double
Dim prsTjry(5) As Double
Dim Kmya As Integer
Dim srfHom(5) As Double
Dim srfTgry(5) As Double
Dim FrstDate As Date
Dim EndDate As Date
Dim AutoAmount As Double
'======================
Kmya = Choose(ktr, 90, 135, 180, 270, 360, 225)
dats(1) = (#2/28/2016#)
dats(2) = (#5/30/2016#)
dats(3) = (#8/31/2017#)
dats(4) = (#6/30/2018#)
dats(5) = (Date)
prsHom(1) = 30
prsHom(2) = 50
prsHom(3) = 52
prsHom(4) = 64.5
prsHom(5) = 67.5
prsTjry(1) = 1.16
prsTjry(2) = 1.6
prsTjry(3) = 2
prsTjry(4) = 2.4
prsTjry(5) = 3.6
srfHom(1) = 0.52
srfHom(2) = 0.51
srfHom(3) = 0.57
srfHom(4) = 0.63
srfHom(5) = 0.75
srfTgry(1) = 0.81
srfTgry(2) = 0.8
srfTgry(3) = 0.86
srfTgry(4) = 0.92
srfTgry(5) = 0.98
'=======================

'If strtDat <= dats(1) Then
  
    For n = 1 To DateDiff("m", strtDat, Date)
        If AutoAmount <= (Amount + 100) And AutoAmount >= (Amount - 100) Then
        Exit For
            tstAmont = "AmountCalculit: " & AutoAmount & vbCrLf & _
                        "Until date: " & IIf(stopDat > 0, stopDat, EndDate)
            Debug.Print AutoAmount
            Debug.Print Amount
            Debug.Print n
            Debug.Print stopDat
            Debug.Print EndDate
        Else
        n = n + 1
        EndDate = DateAdd("m", n, strtDat)
            If Nsht = 1 Then
                If (stopDat <= dats(1)) Then
                AutoAmount = DateDiff("m", EndDate, stopDat) * whdat * prsHom(1) * IIf(srf = 1, 1 + srfHom(1), 1)
                ElseIf (EndDate <= dats(1)) Then
                AutoAmount = DateDiff("m", EndDate, dats(1)) * whdat * prsHom(1) * IIf(srf = 1, 1 + srfHom(1), 1)
                End If
                
                If (stopDat <= dats(2) And stopDat > dats(1)) Then
                AutoAmount = DateDiff("m", EndDate, dats(1)) * whdat * prsHom(1) * IIf(srf = 1, 1 + srfHom(1), 1)
                AutoAmount = DateDiff("m", dats(1), stopDat) * whdat * prsHom(2) * IIf(srf = 1, 1 + srfHom(2), 1)
                ElseIf (EndDate <= dats(2) And EndDate > dats(1)) Then
                AutoAmount = DateDiff("m", EndDate, dats(1)) * whdat * prsHom(1) * IIf(srf = 1, 1 + srfHom(1), 1)
                AutoAmount = AutoAmount + (DateDiff("m", dats(1), dats(2)) * whdat * prsHom(2) * IIf(srf = 1, 1 + srfHom(2), 1))
                End If
                
                If stopDat <= dats(3) And stopDat > dats(2) Then
                AutoAmount = DateDiff("m", EndDate, dats(1)) * whdat * prsHom(1) * IIf(srf = 1, 1 + srfHom(1), 1)
                AutoAmount = DateDiff("m", dats(1), dats(2)) * whdat * prsHom(2) * IIf(srf = 1, 1 + srfHom(2), 1)
                AutoAmount = DateDiff("m", dats(2), stopDat) * whdat * prsHom(3) * IIf(srf = 1, 1 + srfHom(3), 1)
                ElseIf (EndDate <= dats(3) And EndDate > dats(2)) Then
                AutoAmount = DateDiff("m", EndDate, dats(1)) * whdat * prsHom(1) * IIf(srf = 1, 1 + srfHom(1), 1)
                AutoAmount = AutoAmount + (DateDiff("m", dats(1), dats(2)) * whdat * prsHom(2) * IIf(srf = 1, 1 + srfHom(2), 1))
                AutoAmount = AutoAmount + (DateDiff("m", dats(2), dats(3)) * whdat * prsHom(3) * IIf(srf = 1, 1 + srfHom(3), 1))
                End If
                
                If stopDat <= dats(4) And stopDat > dats(3) Then
                AutoAmount = DateDiff("m", EndDate, dats(1)) * whdat * prsHom(1) * IIf(srf = 1, 1 + srfHom(1), 1)
                AutoAmount = DateDiff("m", dats(1), dats(2)) * whdat * prsHom(2) * IIf(srf = 1, 1 + srfHom(2), 1)
                AutoAmount = DateDiff("m", dats(2), dats(3)) * whdat * prsHom(3) * IIf(srf = 1, 1 + srfHom(3), 1)
                AutoAmount = DateDiff("m", dats(3), stopDat) * whdat * prsHom(4) * IIf(srf = 1, 1 + srfHom(4), 1)
                ElseIf (EndDate <= dats(4) And EndDate > dats(3)) Then
                AutoAmount = DateDiff("m", EndDate, dats(1)) * whdat * prsHom(1) * IIf(srf = 1, 1 + srfHom(1), 1)
                AutoAmount = AutoAmount + (DateDiff("m", dats(1), dats(2)) * whdat * prsHom(2) * IIf(srf = 1, 1 + srfHom(2), 1))
                AutoAmount = AutoAmount + (DateDiff("m", dats(2), dats(3)) * whdat * prsHom(3) * IIf(srf = 1, 1 + srfHom(3), 1))
                AutoAmount = AutoAmount + (DateDiff("m", dats(3), dats(4)) * whdat * prsHom(4) * IIf(srf = 1, 1 + srfHom(4), 1))
                End If
                
                If stopDat <= dats(5) And stopDat > dats(4) Then
                AutoAmount = DateDiff("m", EndDate, dats(1)) * whdat * prsHom(1) * IIf(srf = 1, 1 + srfHom(1), 1)
                AutoAmount = DateDiff("m", dats(1), dats(2)) * whdat * prsHom(2) * IIf(srf = 1, 1 + srfHom(2), 1)
                AutoAmount = DateDiff("m", dats(2), dats(3)) * whdat * prsHom(3) * IIf(srf = 1, 1 + srfHom(3), 1)
                AutoAmount = DateDiff("m", dats(3), dats(4)) * whdat * prsHom(4) * IIf(srf = 1, 1 + srfHom(4), 1)
                AutoAmount = DateDiff("m", dats(4), stopDat) * whdat * prsHom(5) * IIf(srf = 1, 1 + srfHom(5), 1)
                ElseIf (EndDate <= dats(5) And EndDate > dats(4)) Then
                AutoAmount = DateDiff("m", EndDate, dats(1)) * whdat * prsHom(1) * IIf(srf = 1, 1 + srfHom(1), 1)
                AutoAmount = AutoAmount + (DateDiff("m", dats(1), dats(2)) * whdat * prsHom(2) * IIf(srf = 1, 1 + srfHom(2), 1))
                AutoAmount = AutoAmount + (DateDiff("m", dats(2), dats(3)) * whdat * prsHom(3) * IIf(srf = 1, 1 + srfHom(3), 1))
                AutoAmount = AutoAmount + (DateDiff("m", dats(3), dats(4)) * whdat * prsHom(4) * IIf(srf = 1, 1 + srfHom(4), 1))
                AutoAmount = AutoAmount + (DateDiff("m", dats(4), dats(5)) * whdat * prsHom(5) * IIf(srf = 1, 1 + srfHom(5), 1))
                End If
                
            End If
        'else tjary
        End If
    Next

End Function

وعند اختبارها لم تظهر أي نتائج أو حتي أخطاء!! ولا أدري لما؟!

?tstAmont(450,1,#8/5/2014#,0,1,1)

 

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

  • أفضل إجابة

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

الحمد لله تم اكتشاف الخطأ بالكود 

هو عند الخروج من الدوار فور قبل نتيجة الدالة الصورة توضح المقال

الخطأ هنا

        If AutoAmount <= (Amount + 100) And AutoAmount >= (Amount - 100) Then
        Exit For <<====================== here a wrong
            tstAmont = "AmountCalculit: " & AutoAmount & vbCrLf & _
                        "Until date: " & IIf(stopDat > 0, stopDat, EndDate)

        Else

كان يجب أن يكتب هكذا

        If AutoAmount <= (Amount + 100) And AutoAmount >= (Amount - 100) Then
        
            tstAmont = "AmountCalculit: " & AutoAmount & vbCrLf & _
                        "Until date: " & IIf(stopDat > 0, stopDat, EndDate)
		
          Exit For  <<=============== must write here after calculate function
        Else

ربما هذا الدالة الطويلة لن يستفيد منها أحد!!

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

(أن الكود يسير من الأعلي الي الأسفل فمن الواجب أن ننتبه أن لا ننهي الكود قبل اتمام احتساب النتائج! كما هو موضح بالأعلي)

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

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

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

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

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

Important Information