طلب كود حذف الحروف والمسافات والإبقاء على الأرقام فقط

[حامل المسك]

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

واسعد الله أوقاتكم بالخيرات والمسرات ..

أساذتنا الفضلاء ..

لدي حقل به أرقام وحروف ومسافات مثل 

خالد سعيد 552332

أريد أمر (زر) يدخل على الجدول في هذا العمود ويقوم بحذف الحروف والمسافات ويبقي الأرقام .. 

وفقكم الله 

[Shivan Rekany]

الیک ھذا
تم الحصول علیە من احد مشاركات استاذنا @أبو إبراهيم الغامدي

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

Function GetNumbersOnly(SText)
    Dim Numbers
    For i = 1 To Len(SText)
        If IsNumeric(Mid(SText, i, 1)) Then
            Numbers = Numbers & Mid(SText, i, 1)
        End If
    Next
    GetNumbersOnly = Trim(Numbers)
End Function

وفي استعلام اكتب هذا

ارقام فقط: GetNumbersOnly([اسم_الحقل])

 

تم تعديل يوليو 20, 2017 بواسطه Shivan Rekany

[حامل المسك]

سلمت رعاك الله ظهرت هذه الرسالة ؟؟؟

/

تم تعديل يوليو 20, 2017 بواسطه حامل المسك

[Shivan Rekany]

جرب ان تكتب في بداية الكود 

Dim I As Integer

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

Function GetNumber(ByVal pStr As String) As Long
Dim intLen  As Integer
Dim n       As Integer
    pStr = Trim(pStr) 'removes leading & trending spaces
    intLen = Len(pStr) 'stores original length
    n = 1 'consider this a counter & position marker
    If pStr = "" Or IsNull(pStr) Or intLen = 0 Then Exit Function 'validate we didn't get passed an empty/null string
    Do
        If IsNumeric(Mid(pStr, n, 1)) Then 'check if that single character is a number
            GetNumber = GetNumber & Mid(pStr, n, 1) 'if it is add to existing ones if any
            n = n + 1 'add to counter so we know to go to next character on the next pass/loop
        Else
            n = n + 1 'it wasn't a number, add to counter so we know to skip it
        End If
    Loop Until intLen = (n - 1) 'go until we processed all characters. The reason we have to do n-1 is that Len starts at 0 & we told n to start at 1
End Function 'if no numbers function will return default value of data type, in our case long would be 0

واتفضل 
اليك هذا بها طريقتين وكلا من طريقتين بيعطينا النتيجة المطلوبة

 

حذف المسافات ويبقى الارقام فقط.rar

تم تعديل يوليو 20, 2017 بواسطه Shivan Rekany

[jjafferr]

السلام عليكم

 

بما ان أخي شفان جاء بكود اخونا أبو ابراهيم الغامدي ، فاليك التغيير المطلوب لحل مشكلتك:

Function GetNumbersOnly(SText)
    Dim Numbers

if len(SText & "")=0 then
	GetNumbersOnly=""
	exit function
end if

    For i = 1 To Len(SText)
        If IsNumeric(Mid(SText, i, 1)) Then
            Numbers = Numbers & Mid(SText, i, 1)
        End If
    Next
    GetNumbersOnly = Trim(Numbers)
End Function

 

جعفر