اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

هديتي لكم :نموذج تنظيف الجداول من المسافات الزائده واستبدال الحروف ة,ى,أ,إ,آ


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

فى هذا المثال اقدم لكم 
نموذج لتنظيف الجداول من المسافات فى بداية الحقول حتى لو كانت مسافة واحده
 ومن المسافات المتكرره فى اى مكان اخر
وكذلك استبدال الحروف التى تسبب مشاكل فى البحث
المثال لا يتعرض لعملية الادخال للبيانات او البحث لكن لتنظيف الجداول 
ويمكنك استدعاء الوظائف بعد عمليات الادخال او التعديل لتبقى الجداول نظيفة
فى عمليات الاستبدال الضخمه قد تحتاج لزرع مفتاح ريجستري بسيط
اعددته لكم بقيم متعددة وقد لا تحتاج له نهائيا 
عسى ان ينال هذا العمل رضاكم
وننال به رضى الله
مسموح بالاستخدام التجاري بشرط الابقاء فقط على صورة ورابط مؤسسة وعد وليس كل المحتوى الخاص بالمؤسسة فقط الصورة والرابط
نرحب باى افكار لتطوير الكود
ارفقت لكم جداول للتجربه بها بيانات 

التطبيق بالمرفقات

1.JPG

2.JPG

3.JPG

tablescleaner.rar

تم تعديل بواسطه طير البحر
  • Like 1
رابط هذا التعليق
شارك

لو سمحت لو عايز ازيل المسافات بين الأسماء المركبة مثل ( عبد الصبور ) تبقي ( عبدالصبور ) بدون مسافات زي الاكسيل

ماذا اضيف للبرنامج

وشكرا جزيلا علي مجهودك

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

On 4/20/2024 at 5:02 PM, 2saad said:

شكرا لحضرتك 

أنا حاولت اطبق علي ملف حضرتك في الكود الذي به تغييرات الحروف ولكن عند التطبيق يعطيني خطأimage.png.da4c2439483e7b34b8210172ea10aaf7.png

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

Option Compare Database

Public Function ReplaceCharacters()
    Dim db As Database
    Dim tblDef As TableDef
    Dim fld As Field
    Dim rs As Recordset
    Dim oldChar1 As String
    Dim newChar1 As String
    Dim oldChar2 As String
    Dim newChar2 As String
    Dim oldChar3 As String
    Dim newChar3 As String
    Dim oldChar4 As String
    Dim newChar4 As String
    Dim oldChar5 As String
    Dim newChar5 As String
    Dim selectedTable As String
    Dim replaceCount As Long
    
    ' تحديد الحروف التي تريد استبدالها
    oldChar1 = "عبد "
    newChar1 = "عبد"
    oldChar2 = "ى"
    newChar2 = "ي"
    oldChar3 = "أ"
    newChar3 = "ا"
    oldChar4 = "إ"
    newChar4 = "ا"
    oldChar5 = "آ"
    newChar5 = "ا"
    
    ' الحصول على اسم الجدول المحدد من combobox
    selectedTable = Me.tabelscombo.Value ' تأكد من تغيير "tabelscombo" بالاسم الصحيح لل combobox الخاص بك
    
    ' افتح قاعدة البيانات
    Set db = CurrentDb
    
    ' التحقق من أن الجدول المحدد صالح
    On Error Resume Next
    Set tblDef = db.TableDefs(selectedTable)
    On Error GoTo 0
    
    If tblDef Is Nothing Then
        MsgBox "الجدول المحدد غير صالح!", vbExclamation
        Exit Function
    End If
    
    ' إعادة تعيين العداد
    replaceCount = 0
    
    ' حلقة عبر جميع الحقول في الجدول المحدد
    For Each fld In tblDef.Fields
        ' تجاهل أي حقل حاسوبي
        If Not fld.Attributes And dbAutoIncrField Then
            ' تأكيد على أن الحقل يحتوي على بيانات قابلة للبحث والاستبدال
            If fld.Type = dbText Or fld.Type = dbMemo Then ' التحقق من أن الحقل يحتوي على نص
                ' استبدال الحرف الأول في القيمة الحالية للحقل
                Set rs = db.OpenRecordset("SELECT * FROM [" & selectedTable & "] WHERE [" & fld.Name & "] LIKE '*" & oldChar1 & "*'")
                Do While Not rs.EOF
                    rs.Edit
                    Dim replacedText As String
                    replacedText = Replace(rs(fld.Name).Value, oldChar1, newChar1)
                    If replacedText <> rs(fld.Name).Value Then
                        rs(fld.Name).Value = replacedText
                        replaceCount = replaceCount + 1 ' زيادة العداد بمقدار واحد
                    End If
                    rs.Update
                    rs.MoveNext
                Loop
                rs.Close
                
                ' استبدال الحرف الثاني في القيمة الحالية للحقل
                Set rs = db.OpenRecordset("SELECT * FROM [" & selectedTable & "] WHERE [" & fld.Name & "] LIKE '*" & oldChar2 & "*'")
                Do While Not rs.EOF
                    rs.Edit
                    Dim replacedText As String
                    replacedText = Replace(rs(fld.Name).Value, oldChar2, newChar2)
                    If replacedText <> rs(fld.Name).Value Then
                        rs(fld.Name).Value = replacedText
                        replaceCount = replaceCount + 1 ' زيادة العداد بمقدار واحد
                    End If
                    rs.Update
                    rs.MoveNext
                Loop
                rs.Close
                
                ' استبدال الحرف الثالث في القيمة الحالية للحقل
                Set rs = db.OpenRecordset("SELECT * FROM [" & selectedTable & "] WHERE [" & fld.Name & "] LIKE '*" & oldChar3 & "*'")
                Do While Not rs.EOF
                    rs.Edit
                    Dim replacedText As String
                    replacedText = Replace(rs(fld.Name).Value, oldChar3, newChar3)
                    If replacedText <> rs(fld.Name).Value Then
                        rs(fld.Name).Value = replacedText
                        replaceCount = replaceCount + 1 ' زيادة العداد بمقدار واحد
                    End If
                    rs.Update
                    rs.MoveNext
                Loop
                rs.Close
                
                ' استبدال الحرف الرابع في القيمة الحالية للحقل
                Set rs = db.OpenRecordset("SELECT * FROM [" & selectedTable & "] WHERE [" & fld.Name & "] LIKE '*" & oldChar4 & "*'")
                Do While Not rs.EOF
                    rs.Edit
                    Dim replacedText As String
                    replacedText = Replace(rs(fld.Name).Value, oldChar4, newChar4)
                    If replacedText <> rs(fld.Name).Value Then
                        rs(fld.Name).Value = replacedText
                        replaceCount = replaceCount + 1 ' زيادة العداد بمقدار واحد
                    End If
                    rs.Update
                    rs.MoveNext
                Loop
                rs.Close
                
                ' استبدال الحرف الخامس في القيمة الحالية للحقل
                Set rs = db.OpenRecordset("SELECT * FROM [" & selectedTable & "] WHERE [" & fld.Name & "] LIKE '*" & oldChar5 & "*'")
                Do While Not rs.EOF
                    rs.Edit
                    Dim replacedText As String
                    replacedText = Replace(rs(fld.Name).Value, oldChar5, newChar5)
                    If replacedText <> rs(fld.Name).Value Then
                        rs(fld.Name).Value = replacedText
                        replaceCount = replaceCount + 1 ' زيادة العداد بمقدار واحد
                    End If
                    rs.Update
                    rs.MoveNext
                Loop
                rs.Close
            End If
        End If
    Next fld
    
    ' إغلاق قاعدة البيانات
    db.Close
    
    ' عرض رسالة الاستبدال بمقدار العداد
    MsgBox "تمت عملية الاستبدال بنجاح! تم استبدال " & replaceCount & " حرفًا.", vbInformation
End Function

 

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

شكرا استاذي الفاضل 

أنا بدلت الكود القديم بالجديد 

وعند التطبيق 

تمام في حذف المسافات

ولكن عند تطبيق تبديل الخمسة اشياء  يعطيني خطأ في الكود

مرفق لحضرتك الملف بعد تبديل الكودcleantabeles.accdb

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

cleantabeles.rar

1 hour ago, 2saad said:

شكرا استاذي الفاضل 

أنا بدلت الكود القديم بالجديد 

وعند التطبيق 

تمام في حذف المسافات

ولكن عند تطبيق تبديل الخمسة اشياء  يعطيني خطأ في الكود

مرفق لحضرتك الملف بعد تبديل الكودcleantabeles.accdb

تفضل اخي 
كان هناك خطأين
اعتذر عنهم لاني جمعت لك الكود بسرعة وكنت اختبر من زر وليس موديول
فقط تستبدل me باسم النموذج هكذا forms!cleaner
كما ان هناك متغير معلن اكثر من مرة اوقفته
الان الكود يعمل لكننا استبدلنا احد الحروف الخمسة بكلمة عبد لامكانك اضافة حلقة جديدة للحرف او اى شئ اخر

1111.JPG

22222.JPG

cleantabeles.rar

تم تعديل بواسطه طير البحر
  • Like 2
رابط هذا التعليق
شارك

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information