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

[محمد يوسف ابو يوسف]

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

اريد تعديل هذا الكود ليناسب عملي

شكرا لكم علي ما تقدموه لنا من مساعدات

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

المطلوب : ايجاد معادلة مثلا: لضرب 60*30 الخ...

  سليم.xlsm

[محي الدين ابو البشر]

ما رأيك بهكذا

سليم.xlsm

[Ali Mohamed Ali]

بارك الله فيك استاذ محي ولإثراء الموضوع يمكنك استخدام هذه المعادلة المعرفة وهذا هو كودها

Function Evals(t As String) As Double
Dim c As String, i As Long
For i = 1 To Len(t)
    If Asc(Mid(t, i, 1)) < 58 And Asc(Mid(t, i, 1)) > 41 Then c = c & Mid(t, i, 1)
Next
Evals = Evaluate(c)
End Function

ثم تكتب المعادلة بالخلية B2 على النحو التالى :

=Evals(A2)

سليم1.xlsm

[محمد يوسف ابو يوسف]

استاذ محي الدين ابو البشر بارك الله فيك 

جزاكم الله خيرا هذا هو المطلوب

اسأل الله عز وجل ان  يجعلة في مزان حسناتكم

 

[محي الدين ابو البشر]

بسيطة

استبدل الكود بهذا الكود

Sub test()
    Dim a As Variant
    Dim m As Object
    Dim r, i
    r = ActiveSheet.Cells(Rows.Count, 3).End(xlUp).Row
    With CreateObject("VBScript.RegExp")
        .Global = True
        .Pattern = "(\d.*\d)"
        For i = 2 To r
            Set m = .Execute(Cells(i, 3))
            a = Split(m(0), "*")
            Cells(i, 3).Offset(, 1) = a(0) * a(1)
        Next
    End With
End Sub

 

سليم (2).xlsm

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

[محي الدين ابو البشر]

_البرنامج 1-7-2020 - نسخة.xls

[محمد يوسف ابو يوسف]

استاذ محي الدين ابو البشر جزاك الله خيرا

هذا هو المطلوب شكراً لحضرتك

شكرا لهذا المنتدي الجميل  الذي يقدم لنا دائماً المساعدات

اشأل الله العلي القدير ان يجعل اعمالكم في مزان حسناتكم

[محي الدين ابو البشر]

الحمد لله أنه تم المطلوب

وبارك الله لك