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

دالة استخراج النص او الارقام


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

السلام عليكم

 

Option Explicit

'            بسم الله الرحمن الرحيم               "
'           *********************              "

'         دالة استخراج النص او الارقام          "
'=============================================="
'   False =  مهمل او   Kh_Number  اذا كان      "
'           تقوم باستخراج النص                 "
'         True =    Kh_Number  اذا كان         "
'           تقوم باستخراج الارقام               "
'=============================================="
'-----------------------------------------------------------------
 
Function Kh_Replace_Text(ByVal Kh_Sub As String, Optional Kh_Number As Boolean)

Dim Num As Byte, C As Integer
Dim Sn As String, Re As String, Md As String
Sn = Trim(Kh_Sub)
For Num = 0 To 9
    Sn = Replace(Sn, Num, "")
Next Num
If Kh_Number Then
    Re = Trim(Kh_Sub)
    Do While C < Len(Trim(Sn))
        C = C + 1
        Md = Mid(Sn, C, 1)
        Re = Replace(Re, Md, "")
    Loop
    Kh_Replace_Text = CDbl(Re)
Else
    Kh_Replace_Text = Trim(Sn)
End If
End Function

دالة استخراج النص او الارقام.rar

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

السلام عليكم

أستاذنا العظيم

بارك الله فيك

وفي أوقاتك

إسمح لي بطلب للفائدة

إذا سمح وقتك :ان تضيف شرط

إن كانت البوينت بين رقمين تظل مع الأرقام

لأن لو الرقم ليس رقما صحيحا أي به بوينت يضمها مع الحروف

كأن تكون العبارة " حصل محمد علي 33.75 درجة"

وجزاك الله كل الخير علي ماقدمت وماتقدم لجميع الأعضاء

تلميذكم / طارق محمود

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

السلام عليكم

اخي الحبيب خبور خير

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

وجعلها الله في ميزان حسناتك ان شاء الله تعالى

عماد الحسامي

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

السلام عليكم

الاخ الفاضل / مصطفى الفيومي------ حفظه الله

الاخ الحبيب/ محمدي عبد السميع------ حفظه الله

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

تقبلا تحياتي وشكري

====================================================

الاخ الحبيب/ طارق ------ حفظه الله

إذا سمح وقتك :ان تضيف شرط

إن كانت البوينت بين رقمين تظل مع الأرقام

جرب الدالة ادناه:

اذا اردت الرقم العشري عين Kh_Point

تساوي True او اي رقم غير الصفر

مثلا:

=Kh_Replace_Text($A4;1;1)
منتظر ردك ====================================================
Option Explicit


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

'           *********************              "


'         دالة استخراج النص او الارقام          "

'=============================================="

'   False =  مهمل او   Kh_Number  اذا كان      "

'           تقوم باستخراج النص                 "

'         True =    Kh_Number  اذا كان         "

'           تقوم باستخراج الارقام               "

'               ----------                     "

'         True =    Kh_Point  اذا كان          "

'      تقوم باستخراج الرقم العشري الاول         "

'=============================================="

'-----------------------------------------------------------------


Function Kh_Replace_Text(ByVal Kh_Sub As String, Optional Kh_Number As Boolean, Optional Kh_Point As Boolean)


Dim Num As Byte, C As Integer

Dim Sn As String, Re As String, Md As String

Sn = Trim(Kh_Sub)

For Num = 0 To 9

    Sn = Replace(Sn, Num, "")

Next Num

If Kh_Number Then

    Re = Trim(Kh_Sub)

    Do While C < Len(Trim(Sn))

        C = C + 1

        Md = Mid(Sn, C, 1)

        If Kh_Point Then If Md = "." Then GoTo 1

        Re = Replace(Re, Md, "")

1

    Loop

    Kh_Replace_Text = Val(Re)

Else

    Kh_Replace_Text = Trim(Sn)

End If

End Function

========================================================

دالة استخراج النص او الارقام1.rar

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

السلام عليكم

أخي الحبيب

وأستاذي الجليل

منتظر ردك

طبعا ردي معروف

تمام التمام

والله إني لأحبك في الله

بارك الله لك وفيك وفي كل أحبابك

تم تعديل بواسطه TareQ M
رابط هذا التعليق
شارك

السلام عليكم

الاخ الحبيب/ عادل ------ حفظه الله

اكرمك الله في الدارين

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

=================================

الاخ الحبيب/ طارق------ حفظه الله

طبعا ردي معروف

تمام التمام

اللهم لك الحمد كما ينبغي لجلال وجهك وعظيم سلطانك

والله إني لأحبك في الله

بارك الله لك وفيك وفي كل أحبابك

ادام الله المحبه فيه

لك حبي وامتناني

ودمتم في حفظ الله

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

  • 8 months later...
  • 3 weeks later...
  • 1 month later...

جزاكم الله خيراً اخواني على إثراءنا بالمعلومات القيمة .... أكواد متقدمة جداً

ملحوظة بسيطة واظن ممكن أخذها في الحسبان:

في الخلية A12 مكتوب التالي

درجة الحرارة -12.5 مئوية

العلامة السالبة لا يتم أخذها في الحسبان كلازمة للرقم.

وأشكركم

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

  • 5 months later...
  • 2 months later...

كنت اظن انني بارع في الاكسل الا انني صدمت عندما قرأة هذه الدوال وكيفية تطبيقها على البرنامج كلما زادت معرفتي زاد جهلي

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

زائر
هذا الموضوع مغلق.
×
×
  • اضف...

Important Information