كود الغاء المسافات بين الاسماء

[علي هندسة]

السلام عليكم

ممكن المساعدة في كود الغاء السافات بين الاسماء في جدول 

فمثلا الاسم      معن سعد محمود جاسم

تصبح               معنسعدمحمودجاسم

 

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

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

تفضل اخي الكريم

NewName: [Text1] & "" & [Text2] & "" & [Text3] & "" & [Text4]

تحياتي

[علي هندسة]

شكرا اخي محمد ابوعبد الله على سرعة الاجابة

الاسماء عباره عن حقل واحد في جدول كما في المرفق وشكرا

tp.mdb

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

تفضل استعلام + نموذج

tp.rar

تحياتي

[ابو عارف]

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

او يمكن استخدام دالة Replace بدون وحدة نطمية(موديل) 

tp.rar

[علي هندسة]

السلام عليكم

شكرا للاستاذ ابو عارف وللاستاذ محمد ابوعبد الله على اجابتهم

كود رائع وبالتوفيق ان شاء الله

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

اي الغاء المسافات على يمين ويسار  الاسم وجعل المسافة واحدة بين اسم الشخص والاب وكذلك بين الاب والجد .

[ابو عارف]

اخي علي هندسة

 هناك ثلاثة دوال لازالة مسافة

LTrim([Xname])'حذف مسافة يسار
RTrim([Xname])'حذف مسافة يمين
Trim([Xname])'حذف مسافة يمين واليسار

 بتوفيق،،،

[علي هندسة]

السلام عليكم

شكرا استاذ ابو عارف على الاجابة

ولكن كيف يتم تنفيذ الدوال الثلاثة بكود لقاعدة البيانات السابقة

وماذا بخصوص المسافة بين الكلمات كما في الصورة المرفقة

[ابو عارف]

9 ساعات مضت, علي هندسة said:

شكرا استاذ ابو عارف على الاجابة

العفو اخي الكريم

9 ساعات مضت, علي هندسة said:

ولكن كيف يتم تنفيذ الدوال الثلاثة بكود لقاعدة البيانات السابقة

Trim([Xname])

ازالة مسافة فبل كتابة الاسم في خانة الاسم و مسافة بعد اسم الكامل مثلا   " احمد محمود ابراهيم " الى  "احمد محمود ابراهيم" 

RTrim([Xname])

ازالة مسافة يمين فقط " احمد محمود ابراهيم " الى "احمد محمود ابراهيم "

و LTrim   " احمد محمود ابراهيم " الى " احمد محمود ابراهيم"

9 ساعات مضت, علي هندسة said:

وماذا بخصوص المسافة بين الكلمات كما في الصورة المرفقة

Expr1: Replace(Replace(Replace(Replace([Xname],"  "," "),"  "," "),"  "," "),"  "," ")

هذا دالة تعيد من واحد لغاية خمسة مسافات الى مسافة واحدة، اذا كانت مسافات اكثر من خمسة اضف replace آخر

tp.rar

تم تعديل ديسمبر 19, 2018 بواسطه ابو عارف

[علي هندسة]

السلام عليكم

شكرا استاذ ابو عارف على الاجابة وشكرا على تعاونك 

لدي مشكلة بخصوص كود الغاء المسافة بين الاسماء

Function RemoveSpaces(TextString As String) As String
Dim TempText As String

    Do While Len(TextString) > 0
        If Left(TextString, 1) <> " " Then
            TempText = TempText & Left(TextString, 1)
        End If
           (TextString = Mid(TextString, 2
    Loop
    RemoveSpaces = TempText
End Function

 ()Private Sub Cnm01_Click
Dim c, i
("c = DCount("[Xname]", "Table
DoCmd.GoToRecord , , acFirst
For i = 1 To c
XXname = RemoveSpaces(Xname)
DoCmd.GoToRecord , , acNext
Next i
End Sub

End Sub

فهو بطيء ويستغرق مدة بالنسبة للسجلات الكثيرة ويصل لحد 18000 سجل تقريبا ويهمل الباقي هل يمكن تنفيذ الكود بسرعة وعلى كل السجلات

والمشكلة الثانية هي بخصوص الكود الغاء المسافات الزائدة بين الاسماء

Expr1: Replace(Replace(Replace(Replace([Xname],"  "," "),"  "," "),"  "," "),"  "," ")

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

وشكرا لك استاذي

[ابو عارف]

تفضل اخي الكريم

للازالة مسافة بين اسماء

Function hr_Sps(MyText As String) As String
Dim txt, txtA
For Each txt In Split(MyText)
        If Len(txt) Then txtA = txtA & " " & txt
Next
hr_Sps = Trim(txtA)
End Function

 

()Private Sub Cnm01_Click
Dim DB As DAO.Database
Dim rst As DAO.Recordset
Set DB = CurrentDb
Set rst = DB.OpenRecordset("table")
rst.MoveFirst
Do Until rst.EOF
rst.Edit
rst!Xname = hr_Sps(rst!Xname)
rst.Update
rst.MoveNext
Loop
MsgBox "تم تحديث بيانات بنجاح"
End Sub

و للمسافات زائدة استبدل سطر الرابع         If Len(txt) Then txtA = txtA & " " & txt

على                                                          If Len(txt) Then txtA = txtA & "" & txt

واخيرا اضافة مكتبة

 

[علي هندسة]

رائع رائع استاذ ابو عارف وهو المطلوب

بارك الله فيك

 

[ابو عارف]

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