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

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

السلام عليكم

 

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

[mostafaatiya]

جزاك الله خيرا استاذ خبور علي هذا الابداع

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

[محمدي عبد السميع]

ماشاء الله

عمل ولاأروع

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

[طارق محمود]

السلام عليكم

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

بارك الله فيك

وفي أوقاتك

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

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

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

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

كأن تكون العبارة " حصل محمد علي 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

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

السلام عليكم

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

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

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

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

[عادل حنفي]

السلام عليكم

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

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

خالص تحياتي و تقديري

[طارق محمود]

السلام عليكم

أخي الحبيب

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

منتظر ردك

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

تمام التمام

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

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

تم تعديل يوليو 21, 2010 بواسطه TareQ M

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

السلام عليكم

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

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

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

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

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

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

تمام التمام

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

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

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

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

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

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

[أبوســـارة1973]

وتتوالى الإنجازات يا كبير

[أبوعبد الله]

بارك الله فيك ياأستاذ .

[خالدو]

جزاك الله خيراً أستاذنا الكريم

[My eccnw]

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

[الجزيرة]

مبدع دائما

الله يجزاك عنا خير الجزاء : )

[احمد العدوى]

لك كل التقدير

[خالدو]

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

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

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

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

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

وأشكركم

[ياسر الحافظ]

استاذنا الغالي خبور المحترم

ما شاء الله .... ماشاء الله

جميعنا نستفيد من هذه الابداعات

وفقك الله

ياسر الحافظ

[ريان أحمد]

أستاذي لقد أبدعت وما الإبداع منك بشيئ غريب عنك وشرحت ودققت وما التدقيق والشرح الوافي بشيء جديد عنك

أدامك الله فوق رؤؤسنا وحفظك الله وأطال في عمرك

[محمد بيرق]

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

[MAHMOUD ALI YOUSSEF]

السلام عليكم

اكواد قمة في الروعة

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

[ثائرالعراقي]

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