التعديل علي كود يقوم باجراء عمليات حسابية علي نص

[أبو عبدالله الحلوانى]

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

الحقل يحوي نص بهذا الشكل "25.1*12.25*14.6" أو هذا الشكل "65.12+65+98+3.25" أو أيا كانت العملية الحسابية

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

حاولت بهذا الكود ولكن الأمر لم يفلح معي حيث أني استخدمت الدالة mid لتقطيع النص ولكن تم التقطيع حرف حرف وليس رقم رقم

وهذا هو كودي البسيط الغير ناجح

Function CalcMsahaAkar(ByRef txtx As String) As Double
'If InStr(1, txtx, "*") > 0 Then
'CalcMsahaAkar = Round(Split(txtx, "*")(0) * Split(txtx, "*")(1), 2)
'End If
Dim no As Double
Dim no1 As Double
no1 = 1
'CalcMsahaAkar = Val(txtx)
For n = 1 To Len(txtx)
    If Mid(txtx, n, 1) <> "*" Or Mid(txtx, n, 1) <> "+" Then
    Debug.Print Mid(txtx, n, 1)
    no = Mid(txtx, n, 1)
		if Instr(1,txtx,"*")>0 then
    	no1 = no1 * no
		Elseif Instr(1,txtx,"+")>0 then
		no1 = no1 + no
		end if
    End If
Next
    CalcMsahaAkar =Round(no1,2)
    Debug.Print CalcMsahaAkar
End Function

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

تم تعديل أكتوبر 10, 2020 بواسطه أبو عبدالله الحلوانى

[أبو عبدالله الحلوانى]

up

[Shivan Rekany]

17 ساعات مضت, أبو عبدالله الحلوانى said:

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

الحقل يحوي نص بهذا الشكل "25.1*12.25*14.6" أو هذا الشكل "65.12+65+98+3.25" أو أيا كانت العملية الحسابية

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

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

اتفضل اليك هذا 

Option Compare Database

Function RiaziyatTxtToNum(SText)
' By Shivan Rekany
    Dim i, ii As Integer
    Dim Elamat
    Dim Encam As Double
    Dim sERCEM As Double
  Dim JimaaZuF As Integer
    For ii = 1 To Len(SText)
        If Mid(SText, ii, 1) = "+" Or Mid(SText, ii, 1) = "*" Or Mid(SText, ii, 1) = "/" Or Mid(SText, ii, 1) = "-" Then
            JimaaZuF = JimaaZuF + 1
        End If
    Next ii
    
Dim LString As String
Dim LArray() As String
    LString = Replace(Replace(Replace(SText, "+", "*"), "-", "*"), "/", "*")
    LArray = Split(LString, "*", Val(JimaaZuF + 1))
    
        For ii = 1 To Len(SText)
            If Mid(SText, ii, 1) = "+" Or Mid(SText, ii, 1) = "*" Or Mid(SText, ii, 1) = "/" Or Mid(SText, ii, 1) = "-" Then Elamat = Elamat & Mid(SText, ii, 1)
        Next ii

    Encam = Val(LArray(0))
    For i = 1 To Len(Elamat)
        If Mid(Elamat, i, 1) = "+" Then
                Encam = Encam + Val(LArray(i))
        ElseIf Mid(Elamat, i, 1) = "*" Then
                Encam = Encam * Val(LArray(i))
        ElseIf Mid(Elamat, i, 1) = "/" Then
                Encam = Encam / Val(LArray(i))
        ElseIf Mid(Elamat, i, 1) = "-" Then
                Encam = Encam - Val(LArray(i))
        End If
    Next i
    
    RiaziyatTxtToNum = Trim(Encam)
    Form_TBL1.sERCEM = RiaziyatTxtToNum
End Function

واليك ملف تم تطبيق عليه

 

Database2.accdb

[أبو عبدالله الحلوانى]

جزاك الله خيرا وجعله الله في موازين حسناتكم