تمييز السجلات التي لا تبدأ بأرقام والتي تحتوي أكثر من رقم بسطر جديد

[nssj]

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

في الملف المرفق حقل نصي (Nass) المطلوب كود لتمييز الصفحات باعتبارين

* الاعتبار الأول: الصفحات التي لا تبدأ بأرقام، يعني في مثل هذه الصفحة

يصبح مربع (check_Page) : نعم

* الاعتبار الثاني: المفترض ألا تحتوي الصفحة إلا على ترقيم واحد، والمطلوب تمييز ما عدا ذلك، وآلية تمييز هذه الصفحات فهي أن يوجد فيها أكثر من فقرة تبدأ برقم،  كما في هذه الصورة

 

فقد تحتوي الصفحة على أرقام في أكثر من موضع كما في الصورة، فإذا كان الرقم في بداية السطر فيعني أنه للترقيم، فإذا كان يوجد أكثر من رقم بهذا الشرط فتميز هذه الصفحة بجعل مربع (check_No) : نعم

check_Book.accdb

تم تعديل ديسمبر 30, 2022 بواسطه nssj

[jjafferr]

السلام عليكم 🙂

 

لأني مستعجل فما اقدر اعطيك تفاصيل ، اليك هذا استعلام التحديث :

UPDATE book SET book.check_Page = IIf(IsNumeric(Left([Nass],1)),-1,Null), book.check_No = IIf(IsNumeric(Left([Nass],1)) And InStr(10,[Nass],Chr(10)),"-1",Null);

.

اعمل استعلام جديد ، لا تختار اي جدول او استعلام ، انقر بالفأرة اليمين واختار اول اختيار SQL view ، ثم الصق الكود فيه ، وشغل الاستعلام 🙂

 

جعفر

[nssj]

وعلكم السلام أخي الكريم جعفر

أولا: لأني أجيد التعامل مع الأكواد أكثر حولت الاستعلام إلى كود

Private Sub com_check_Click()
CurrentDb.Execute "UPDATE book SET book.check_Page = IIf(IsNumeric(Left([Nass],1)),-1,Null), book.check_No = IIf(IsNumeric(Left([Nass],1)) And InStr(10,[Nass],Chr(10)),""-1"",Null)"
MsgBox "DONE"
End Sub

ثانيا: بخصوص الاعتبار الأول فالكود يعمل بالعكس، المطلوب تمييز الصفحات التي لا تبدأ بأرقام، وهو يميز الصفحات التي تبدأ بأرقام

ثالثا: الاعتبار الثاني يعمل بالشكل المطلوب، لكن إذا كانت صفحة لا تبدأ بأرقام وكان فيها أكثر من رقم بالشرط المطلوب لا يعمل الكود، يعني في مثل هذه الصفحة المعدلة:

 

وطبعاً لأني مش فاهم الكود فما عندي قدرة على محاولة التعديل 😅

فإذا وجدت وقتا أخي الكريم فلعلك تتكرم بشرح موجز عن العبارات المستخدمة، فقد تنفعني في اختراعات قادمة 😁 ..   مثلاً عبارة (IsNumeric) ماذا تعني 🤔

[jjafferr]

3 ساعات مضت, nssj said:

أولا: لأني أجيد التعامل مع الأكواد أكثر حولت الاستعلام إلى كود

بالعكس ، هذا موضع استعمال الاستعلام مباشرة ، وليس استعماله من الكود 🙂

 

ثانيا: اضف Not الى الكود ، هكذا

IIf(Not IsNumeric(Left([Nass],1)),-1,Null)

.

اذا اول حرف من اليسار (يعني من بداية الجملة) رقم IsNumeric ، اذن اكتب لي -1 ، وإلا اجعل الحقل Null.

اضافة الامر Not معناه اذا اول حرف لم يكن رقم.

 

.

ثالثا: جرب هاي

IIf(InStr(10,[Nass],Chr(10)),-1,Null)

.

لاحظت انك لما تكتب الجملة ، فكلامك مستمر ، الى ان توصل الى نهاية الجملة وتتوقف. بينما لما تريد اضافة رقم ، فانت تنتقل الى سطر جديد (رمز التعرف على انك ضغطت على زر Enter على لوحة المفاتيح هو Chr(10) )

ابدا البحث في الجملة عن هذا الرمز ابتدأً من الحرف رقم 10 (اعطيتك مجال اذا الارقام عندك وصلت الى 10 خانات 😁) ،

 

.

فيصبح الاستعلام:

UPDATE book SET book.check_Page = IIf(Not IsNumeric(Left([Nass],1)),-1,Null), book.check_No = IIf(InStr(10,[Nass],Chr(10)),-1,Null);

 

.

.

جعفر

[nssj]

أحسن الله إليك أخي الكريم .. بالنسبة للاعتبار الأول (الصفحات التي لا تبدأ بأرقام) تم المطلوب بحمد الله

أما بالنسبة للثاني، فهو يضع علامة في الصفحات التي ليس فيها إلا ترقيم واحد إذا كانت لا تبدأ بأرقام، وظني أن السبب أنه في هذه الحالة يكون الترقيم في أول الفقرة وليس في أول الحقل

 

وإشكالية أخرى ظهرت لي لا أدري ما سببها وهي كما في الصورة

[jjafferr]

انا وضعت شرح في مشاركتي السابقة ، فرجاء ترجع لي بشرح اكثر وامثلة اضافيه عن طلبك الثاني

[nssj]

 

أخي الكريم .. المطلوب تمييز الصفحات التي فيها أكثر من رقم للأحاديث

وحيث أن ترقيم الأحاديث ليس بين أقواس أو رموز خاصة، وأيضا فإن الصفحة قد تحتوي على أرقام أخرى غير أرقام الأحاديث، كأرقام الآيات مثلا [النساء: 176]

فالطريقة الوحيدة لتمييز أرقام الأحاديث هو البحث عن الأرقام التي في أول الفقرات

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

وقد أضفت حقل (aa) وميزت فيه الصفحات المطلوبة يدويا لإجراء المقارنة بين الاستعلامين، وظهر أن الاستعلام الأول (1chek) يؤدي نتيجة أفضل

.. book.check_no = IIf(IsNumeric(Left([Nass],1)) And InStr(10,[Nass],Chr(10)),-1);

فالإشكالية في هذه الصفحات

 

 

 

أما الصفحتان الأولى والثانية فكل منهما لا تبدأ بأرقام، والمطلوب في مثل هذه الصفحات تمييز التي فيها أكثر من فقرة تبدأ برقم، وليس التي فيها فقرة تبدأ برقم

أما الصفحة الثالثة فلا أدري ما السبب، إلا إذا كان الفرق بين ch(10) & ch(13)

فلما استخدمت (13) بدل (10) في الكود لم تظهر الإشكالية في هذه الصفحة لكن حصلت على نتائج مختلفة وأخطاء أكثر !!

وحصلت على النتيجة المطلوبة بالاستعانة بالحقل الذي ميزته يدويا (aa) بجعل الكود يعمل على الصفحات التي فيها اختلاف فقط عبر هذا الكود في النموذج

CurrentDb.Execute "UPDATE book SET book.check_No = IIf(IsNumeric(Left([Nass],1)) And InStr(10,[Nass],Chr(10)),-1)"
CurrentDb.Execute "UPDATE book SET book.check_No = IIf(InStr(10,[Nass],Chr(13)),-1)where book.check_no <> book.aa"

 

هذه حصيلة تجارب الليلة الماضية .. ولم أعرف كيف أجمع بين نتائجها للوصول للمطلوب بشكل دقيق .. هذا إذا كان من الممكن تحقيق ذلك

check_Book2.rar

[Moosak]

أهلا بك أخي @nssj 🙂 

هذه محاولتي فيما يخص النقطة الثانية ، بالاستعانة بالذكاء الاصطناعي 😁

وهذه هي الدالة العامة التي تفحص وجود أكثر من فقرة تبدأ بأرقام :

Public Function CheckParagraphs(text As String) As Boolean
    Dim paragraphs() As String
    paragraphs = Split(text, vbCrLf) ' تقسيم النص إلى فقرات منفصلة
    Dim paragraph As Variant
    Dim x As Integer
    x = 0
    For Each paragraph In paragraphs ' التنقل عبر كل فقرة
        If IsNumeric(Left(paragraph, 1)) Then ' فحص إذا كان الحرف الأول في الفقرة هو رقم
            x = x + 1
                If x >= 2 Then
                    CheckParagraphs = True ' لو كان الحرف الأول في الفقرة هو رقم، يتم إرجاع القيمة True
                    Exit Function ' يتم الخروج من الدالة
                End If
        End If
    Next
    CheckParagraphs = False ' لو لم يتم العثور على فقرة تبدأ برقم، يتم إرجاع القيمة False
End Function

ثم يتم تحديث البيانات في الجدول عن طريق :

' Moosak :
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
   Set dbs = CurrentDb
   Set rst = dbs.OpenRecordset("book")
    rst.MoveLast
   rst.MoveFirst
   Do Until rst.EOF
         rst.Edit
         rst!check_No = CheckParagraphs(rst!Nass)
         rst.Update
      rst.MoveNext
   Loop
Me.Requery

rst.Close
Set dbs = Nothing
Set rst = Nothing

 

check_Book2.rar

تم تعديل ديسمبر 31, 2022 بواسطه Moosak

[nssj]

2 ساعات مضت, Moosak said:

بالاستعانة بالذكاء الاصطناعي 😁

المشكلة أن الذكاء الصناعي غير مناسب للمبتدئين أمثالي .. لأن اقتراحاته يصعب علي استيعابها 😅

أنا أخذت وقتا لأفهم كود الأخ جعفر وهو سطر واحد .. والآن لدي صفحتان 😄

لكن هذا لن يمنعني أن (أُعُلِّمَ) على الذكاء الاصطناعي 😁 .. فلا تزال توجد نفس المشكلة في هذه الصفحة (ويمكن معرفة الخطأ إن وجد باستعلام difference)

 

فإن أمكن تجاوزها فبها ونعمت .. وإلا فالذكاء الاصطناعي حل (95%) من المطلوب .. وأنا قنوع 🙂

[Moosak]

لا الذكاء الصطناعي شغال على قد حاله 😅 ( على قدر المعطيات )

كان ما متعرف على أنه الفقرة بادية من سطر جديد .. فأنا قمت بضغط Enter قبل الفرة الثانية واشتغل زين 🙂 

[jjafferr]

السلام عليكم 🙂

 

انا لازلت على ابو كلتش ، ما تحولت على الاوتوماتيك 🙂

8 ساعات مضت, nssj said:

أما الصفحة الثالثة فلا أدري ما السبب، إلا إذا كان الفرق بين ch(10) & ch(13)

عملت دالة علشان نتأكد ايهم الصح ، فجربت الطرق الثلاث على جميع السجلات :

Function Which_Chr_is_used() As String

    Dim x() As String, x1() As String, x2() As String
    Dim rst As DAO.Recordset
    Set rst = CurrentDb.OpenRecordset("Select ID, Nass From book Order by ID")
    
    Do Until rst.EOF
    
        x = Split(rst!Nass, vbCrLf) 'chr(13) & chr(10)
        x1 = Split(rst!Nass, vbCr)  'chr(13)
        x2 = Split(rst!Nass, vbLf)  'chr(10)
        Debug.Print rst!ID, UBound(x), UBound(x1), UBound(x2)

        rst.MoveNext
    Loop
    
rst.Close: Set rst = Nothing
    
End Function

.

والصقت البيانات في الاكسل ، وبعد عمل تنسيق شرطي ، عرفت بأن فاصل الفقرات هو chr(13) ، لأنه موجود في جميع السجلات اللي نحتاج لها :

.

 

للجزء الثاني ، عملت وحدة نمطية :

Function Search_for_Two_Numbers(ID As Integer, txt As String) As String
On Error GoTo err_Search_for_Two_Numbers

    Dim x() As String
    Dim i As Integer, How_Many_Numbers As Integer

    How_Many_Numbers = 0
    
    '1st letter
    If IsNumeric(Left(txt, 1)) Then
        How_Many_Numbers = How_Many_Numbers + 1
    End If
    
    
    x = Split(txt, Chr(13))
    
    'Do we have a new Paragraph
    'check if the begining of the new Paragraph is a number
    For i = 1 To UBound(x)
    
        If IsNumeric(Mid(x(i), i + 1, 1)) Then
            'Debug.Print ID, Mid(x(i), i + 1, 1)
            How_Many_Numbers = How_Many_Numbers + 1
        End If
    
    Next i


    Search_for_Two_Numbers = How_Many_Numbers
    
    
Exit_Search_for_Two_Numbers:

Exit Function
err_Search_for_Two_Numbers:

    If Err.Number = 9 Then
        Resume Next
    ElseIf Err.Number = 13 Then
        Resume Next
    Else
        MsgBox Err.Number & vbCrLf & Err.Description
    End If
End Function

.

نناديها من الاستعلام.

عملت لك استعلامين ، Query2 حتى تعرف كيف ناديت الوحدة النمطية ، وحتى اذا اردت اللعب بها وترى نتائجها ،

والاستعلام Query3 ليعمل تحديث في الجدول:

 

جعفر

1539.check_Book2.zip

[nssj]

17 دقائق مضت, jjafferr said:

انا لازلت على ابو كلتش ، ما تحولت على الاوتوماتيك 🙂

أما أنا فلا زلت على البسكلته 🛴  😂

هذا مجرد مرور سريع .. لأني بحاجة لوقت لأهضم هذه الوجبات الدسمة .. السهرة الليلة مطولة 😀

[nssj]

حصيلة التجارب .. النتائج الدقيقة تم الوصول لها بكود الأخ Moosak بعد تعديل النص بكود قديم للأخ jjafferr

هذه النتيجة بعد عدة تجارب على عدة ملفات .. كانت تخرج لي نتائج متفاوتة .. وحاولت بعد إجراء عمليات استبدال بين أفراد عائلة [علامات الفقرات: (chr) ]  لكن لم أصل إلى النتيجة المطلوبة وبقيت النتائج متفاوتة لسبب لم أعرفه، لكن كان أداء كود الأخ jjafferr أفضل

ثم استخدمت كود الأخ jjafferr لحذف المسافات والأسطر الفارغة

كود حذف الأسطر الفارغة والمسافات في أول السطر

فحصلت على النتيجة المطلوبة من كود الأخ Moosak، وبقيت بعض الاختلافات في نتيجة كود الأخ jjafferr

وهذه نتيجة الكودين قبل تعديل النص

 

وهذه النتيجة بعد التعديل

 

وفي الملف المرفق جدول (0book) للنص قبل التعديل لاستخدامه عند التجارب، واستعلام تعديل النص (qry_Update)

check_Book4.rar

[jjafferr]

الله يطول عمرك، علشان اقدر اساعدك، رجاء تخبرني بالضبط وين المشكلة 🙂

[nssj]

2 ساعات مضت, jjafferr said:

رجاء تخبرني بالضبط وين المشكلة

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

المشكلة إجمالاً في طريقة تعرف الأكسس على الفقرات وتعدد رموزها

ويبدو أن هذا الأمر يختلف من ملف لآخر حسب طريقة الإدخال والكتابة

لكن استخدام الكود الذي تفضلتَ به سابقا في حذف الأسطر والمسافات الزائدة ، يبدو أنه يوحد رموز الفقرات في الملف، مما يعطي أداء أفضل عند البحث عنها

لكن على الرغم من ذلك، الكود الذي تفضلت به هنا لا يتعرف على بعض الفقرات، في الملف المرفق توجد ثلاث فقرات لم يتعرف عليها، مع أنني خلال التجارب تأكدت من أن كل الفقرات هي (chr13) باستخدام الدالة التي تفضلت بها مشكورا

لكن لما استخدمت كود الأخ  Moosak  -بعد استخدام كود المسافات والأسطر- أعطى النتيجة المطلوبة

أما لماذا تعرف هذا الكود على كل الفقرات بخلاف ذاك مع أن المعطيات واحدة .. فهذا فوق مستوى معرفتي بمرااااحل 😅

الحاصل .. أنه تم الوصول للمطلوب من خلال استخدام كودين .. ولا مشكلة عندي في هذا الأمر

بل هذا يجعلني أفكر بجدية لاستخدام كود حذف الأسطر والمسافات الزائدة على كل الملفات التي أستخدمها في أكسس لتوحيد المنهج

[jjafferr]

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

الكود الذي تفضلت به هنا لا يتعرف على بعض الفقرات

اخبرني ماهي الفقرات التي لم يتعرف عليها ؟

 

اما اذا 

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

تم الوصول للمطلوب

فالحمدلله 🙂