مطلوب كود لنقل رقم بين رموز معينة لعمود آخر ثم حذف السطر كاملا

[nssj]

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

في الملف المرفق جدول (Book) وفيه حقل (Nass) يبدأ بأرقام بين &1&&

والمطلوب نقل الرقم فقط لحقل  (page)

وللتوضيح فقط عملت المطلوب في أول خمسة صفوف

ثم كود آخر لحذف هذه الأسطر التي تبدأ بـ (&) لأنه لم تعد لها حاجة

والأفضل أن يكون كل كودا منفصلا عن الآخر، فلا يلزم من استخدام أحدهما أن أستخدم الآخر

Book.rar

[ابو البشر]

42 دقائق مضت, nssj said:

في الملف المرفق جدول (Book) وفيه حقل (Nass) يبدأ بأرقام بين &1&&

والمطلوب نقل الرقم فقط لحقل  (page)

تفضل .....

الكود لنقل الرقم فقط ...اعلمنا بالنتيجة ....

Sub ExtractSingleNumber()
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim strPattern As String
    Dim strInput As String
    Dim regExp As Object
    Dim matches As Object
    
    ' النمط لاستخراج الرقم بين & و &&
    strPattern = "&(\d+)&&"
    
    ' تهيئة قاعدة البيانات
    Set db = CurrentDb
    Set rs = db.OpenRecordset("SELECT nass, page FROM book")
    
    ' تهيئة كائن التعبير النمطي
    Set regExp = CreateObject("VBScript.RegExp")
    regExp.Pattern = strPattern
    regExp.Global = False
    
    ' المرور عبر السجلات
    Do While Not rs.EOF
        strInput = rs!nass
        
        If regExp.Test(strInput) Then
            Set matches = regExp.Execute(strInput)
            rs.Edit
            rs!Page = matches(0).SubMatches(0) ' الرقم المستخرج
            rs.Update
        End If
        
        rs.MoveNext
    Loop
    
    ' تنظيف الموارد
    rs.Close
    Set rs = Nothing
    Set db = Nothing
    Set regExp = Nothing
    
    MsgBox "تم نسخ الأرقام إلى الحقل page بنجاح!"
End Sub

والكود التالي لحذف السطر الذي به النمط
تفضل ......
 

Sub RemoveAllPatterns()
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim strPattern As String
    Dim strInput As String
    Dim regExp As Object
    
    ' النمط لإزالة كل ما يشبه &رقم&&
    strPattern = "&\d+&&"
    
    ' تهيئة قاعدة البيانات
    Set db = CurrentDb
    Set rs = db.OpenRecordset("SELECT nass FROM book")
    
    ' تهيئة كائن التعبير النمطي
    Set regExp = CreateObject("VBScript.RegExp")
    regExp.Pattern = strPattern
    regExp.Global = True ' لضمان إزالة جميع التطابقات داخل النص
    
    ' المرور عبر السجلات
    Do While Not rs.EOF
        strInput = rs!nass
        
        If regExp.Test(strInput) Then
            rs.Edit
            ' إزالة جميع التطابقات للنمط من النص
            rs!nass = regExp.Replace(strInput, "")
            rs.Update
        End If

        rs.MoveNext
    Loop
    
    ' تنظيف الموارد
    rs.Close
    Set rs = Nothing
    Set db = Nothing
    Set regExp = Nothing
    
    MsgBox "تم حذف جميع الأنماط &رقم&& بنجاح!"
End Sub

 

[nssj]

أحسن الله إليك أخي الكريم

الكودان يؤديان المهمة المطلوبة

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