طلب دالة ذكية للبحث عن رقم معين بعد نص معين

[nssj]

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

عندي جدول (BOOKS) فيه أحاديث كلها موجودة في الجدول الرئيسي (TAB)

وأريد معرفة أماكنها في الجدول الرئيسي وربطها به عبر المفتاح الأساسي (MNO)

وأريد دالة ذكية تسهل هذه المهمة إن أمكن

والجيد في الأمر أنه ليس المطلوب هو البحث التقليدي: اختيار كلمة أو أكثر من الحديث في الجدول (BOOKS)  والبحث عنها في الجدول الرئيسي (TAB)

الأمر بحمد الله أسهل .. على الأقل في تصوري

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

* مثلا: في هذا الحديث من جدول (BOOKS)  :

 

المطلوب من الدالة أن تبحث في حقل (NASS) من الجدول الرئيسي (TAB) عن الحديث الذي فيه اسم الكتاب "مصنفات الحمامي" يليه الرقم (116)، واسم الكتاب من حقل (BookName)، والرقم من حقل (B_Hno)

والحديث المطلوب هو في الجدول الرئيسي (TAB)

 

ثم وضع الرقم (MNO) في جدول (BOOKS)

وقد قمت أنا بوضع الأرقام الصحيحة المطلوبة في حقل (MNOX)

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

فهذا الحديث موجود في جدول (BOOKS) في تسعة مواضع

والدالة ستبحث انطلاقا من جدول (BOOKS)

تبحث في حقل (NASS) من الجدول الرئيسي (TAB) عن الحديث الذي فيه اسم الكتاب "فوائد تمام" يليه رقم (168) وتضع رقمه، ثم تبحث مرة أخرى عن "فوائد تمام" يليه رقم (169) .. وهكذا

 

* مع ملاحظة البحث عن الرقم كاملا، حتى لا يحصل خلط بين:

فوائد تمام (312)   //   فوائد تمام (1312)

 

أرجو أن أكون قد وفقت في شرح المطلوب

ثم أرجو أن يكون بالإمكان عمل ذلك في أكسس لأن ذلك سيوفر لي الكثير من الوقت

Smart_Search.accdb

تم تعديل مايو 31 بواسطه nssj

[M.Abd Allah]

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

انا حاولت اعمل الي حضرتك عايزه واتمني ان تجد المطلوب فى المديول الموجود 

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

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

 

Smart_Search_function.accdb

[nssj]

جزاك الله خيرا أخي الكريم

الماكرو الثاني يكاد يكون أدى المطلوب تماما

Function UpdateBooksWithMNO2()
    Dim db As DAO.Database
    Dim rsBooks As DAO.Recordset
    Dim rsTab As DAO.Recordset
    Dim sql As String
    Dim bookName As String
    Dim bookNumber As String
    Dim fullText As String
    Dim found As Boolean
    Set db = CurrentDb()
    ' فتح مجموعة السجلات للجدول BOOKS
    Set rsBooks = db.OpenRecordset("BOOKS")
    ' التكرار عبر السجلات في BOOKS
    Do While Not rsBooks.EOF
        bookName = rsBooks!bookName
        bookNumber = rsBooks!B_Hno
        found = False
        ' البحث في الجدول الرئيسي TAB
        sql = "SELECT * FROM TAB WHERE NASS LIKE '*" & bookName & " (" & bookNumber & ")*'"
        Set rsTab = db.OpenRecordset(sql)

        If Not rsTab.EOF Then
            rsTab.MoveFirst
            Do While Not rsTab.EOF
                fullText = bookName & " (" & bookNumber & ")"
                If InStr(rsTab!NASS, fullText) > 0 Then
                    rsBooks.Edit
                    rsBooks!mno = rsTab!mno
                    rsBooks.Update
                    found = True
                    Exit Do
                End If
                rsTab.MoveNext
            Loop
        End If
        rsTab.Close
        Set rsTab = Nothing
        rsBooks.MoveNext
    Loop
    rsBooks.Close
    Set rsBooks = Nothing
    Set db = Nothing
End Function

حتى أنه اكتشف خطأ في أحد الأرقام التي أدخلتها يدويا، لأنه كما ذكرت فقد وضعت الأرقام الصحيحة في حقل (MNOX)

وهذا يبين أهمية الدالات الذكية .. لتدارك أخطاء العمل اليدوي 😀

ولكن أول ثلاثة أحاديث لم يعمل فيها الماكرو  !! كما في الصورة

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

 

[nssj]

وطلب آخر إن تكرمت

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

لأنها الطريقة التي اعتدت عليها

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

[M.Abd Allah]

السلام عليكم 

عشان كده لما لقيت في ارقام غير متطابقة

مرضتش أقول إنك ماخدتش بالك وقولت يمكن الداله اللي فيها حاجه

فعملت واحده غيرها 

بص اتأكد من تطابق الارقام كويس وتطابق الكلمات ولو اكيد اعدلك الداله 

أما موضوع الزرار ده بسيطه جدا إن شاءالله دا بيبقي عباره عن أنه في حدث عند النقر نقوله

Call UpdateBooksWithMNO2

[nssj]

20 دقائق مضت, Abo-Abd Allah said:

أما موضوع الزرار ده بسيطه جدا إن شاءالله دا بيبقي عباره عن أنه في حدث عند النقر نقوله

Call UpdateBooksWithMNO2

وهذا ما فعلته أخي الكريم بطريقتين، كما تراه في نموذج (Frm1)

لكن هذه هي النتيجة في الطريقتين

  

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

وتبقى الملاحظة الأولى: لم تعمل الدالة في أول ثلاثة أحاديث حتى باستخدام الماكرو

Smart_Search02.accdb

[Foksh]

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

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

عندي جدول (BOOKS) فيه أحاديث كلها موجودة في الجدول الرئيسي (TAB)

وأريد معرفة أماكنها في الجدول الرئيسي وربطها به عبر المفتاح الأساسي (MNO)

وأريد دالة ذكية تسهل هذه المهمة إن أمكن

والجيد في الأمر أنه ليس المطلوب هو البحث التقليدي: اختيار كلمة أو أكثر من الحديث في الجدول (BOOKS)  والبحث عنها في الجدول الرئيسي (TAB)

الأمر بحمد الله أسهل .. على الأقل في تصوري

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

* مثلا: في هذا الحديث من جدول (BOOKS)  :

 

المطلوب من الدالة أن تبحث في حقل (NASS) من الجدول الرئيسي (TAB) عن الحديث الذي فيه اسم الكتاب "مصنفات الحمامي" يليه الرقم (116)، واسم الكتاب من حقل (BookName)، والرقم من حقل (B_Hno)

والحديث المطلوب هو في الجدول الرئيسي (TAB)

 

ثم وضع الرقم (MNO) في جدول (BOOKS)

وقد قمت أنا بوضع الأرقام الصحيحة المطلوبة في حقل (MNOX)

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

فهذا الحديث موجود في جدول (BOOKS) في تسعة مواضع

والدالة ستبحث انطلاقا من جدول (BOOKS)

تبحث في حقل (NASS) من الجدول الرئيسي (TAB) عن الحديث الذي فيه اسم الكتاب "فوائد تمام" يليه رقم (168) وتضع رقمه، ثم تبحث مرة أخرى عن "فوائد تمام" يليه رقم (169) .. وهكذا

 

* مع ملاحظة البحث عن الرقم كاملا، حتى لا يحصل خلط بين:

فوائد تمام (312)   //   فوائد تمام (1312)

 

أرجو أن أكون قد وفقت في شرح المطلوب

ثم أرجو أن يكون بالإمكان عمل ذلك في أكسس لأن ذلك سيوفر لي الكثير من الوقت

Smart_Search.accdb 456 kB · 3 downloads

موضوع جميل مشوق ، يسعدني المشاركه مع الإخوة الأفاضل بأقرب فرصة 🤗

[M.Abd Allah]

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

موضوع جميل مشوق ، يسعدني المشاركه مع الإخوة الأفاضل بأقرب فرصة 🤗

إذا حضر الماء بطل التيمم اتفضل خد راحتك يا بروف 😉 😉 كده الاستاذ يعتبر أن مشكلته محلوله إن شاءالله ❤️ ❤️ 

 

[Foksh]

أخي الكريم ، عدة نقاط أرجو توضيحها لأني في البداية قرأت الموضوع بشكل سريع ( كنت في طريقي للعمل ) ، الآن كالتالي :-
لنفترض أن لديك نموذج يحتوي مربع نص لاستخدامه للبحث ( على سبيل المثال ) وتريد كتابة البحث داخل الحقل NASS في الجدول TAB ( صحيح ) عن قيم عشوائية يتم كتابتها بشكل يدوي وليس قيم محددة ( صحيح ؟ ) . يعني مثلاُ النتيجة التي تريدها عند البحث عن " فوائد تمام (756) " القيمة مأخوذة من أحي بيانات سجل في الجدول TAB من الحقل NASS ، وعليه فأن النتيجة التي تريد عرضها في النموذج الفرعي للنتئج ماذا ستكون ؟؟؟؟؟؟؟؟

 

لا بأس في شرحك إلا أن الأمور قد تتداخل في بعضها 

[Foksh]

استناداً لفكرة أخي @Abo-Abd Allah ، تم التعديل بشكل بسيط على الكود بحيث يكون البحث داخل النص عن رقم الكتاب وليس ملزماً بموقع الرقم ، أرجو التحقق من النتائج أخي @nssj من الكود التالي :-

Function UpdateBooksWithMNO()
    Dim db As DAO.Database
    Dim rsBooks As DAO.Recordset
    Dim rsTab As DAO.Recordset
    Dim sql As String
    Dim bookNumber As String
    Dim found As Boolean
    Set db = CurrentDb()
    Set rsBooks = db.OpenRecordset("BOOKS")
    Do While Not rsBooks.EOF
        bookNumber = rsBooks!B_Hno
        found = False
        sql = "SELECT * FROM TAB WHERE InStr(NASS, '" & bookNumber & "') > 0"
        Set rsTab = db.OpenRecordset(sql)
        If Not rsTab.EOF Then
            rsTab.MoveFirst
            Do While Not rsTab.EOF
                If InStr(rsTab!NASS, bookNumber) > 0 Then
                    rsBooks.Edit
                    rsBooks!MNO = rsTab!MNO
                    rsBooks.Update
                    found = True
                    Exit Do
                End If
                rsTab.MoveNext
            Loop
        End If
        rsTab.Close
        Set rsTab = Nothing
        rsBooks.MoveNext
    Loop
    rsBooks.Close
    Set rsBooks = Nothing
    Set db = Nothing
End Function

 

Smart_Search_function.accdb

تم تعديل يونيو 1 بواسطه Foksh
إضافة المرفق

[nssj]

أهلا وسهلا بأخي الكريم  Foksh

الدالة عملت في جميع الأحاديث لكن يوجد خطأ في موضعين

 

والسبب هو عدم البحث عن الرقم كاملا، فحصل خلط بين [172 & 1720] [312 & 1312]

 ثانيا: لفظ نظري قولك 

منذ ساعه, Foksh said:

تم التعديل بشكل بسيط على الكود بحيث يكون البحث داخل النص عن رقم الكتاب وليس ملزماً بموقع الرقم

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

لذلك أضفت هذا الرقم في النص

 

وعند ما جربت الدالة تأكدت ظنوني وأعطى النتيجة الخاطئة

 

لذلك لا بد من البحث عن الرقم بعد اسم الكتاب

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

رابعا: التأكد من أن الدالة إن لم تجد الرقم أو النص المطلوب تنتقل لما بعده دون أن تتعطل أو تخرج رسالة خطأ

Smart_Search03.accdb

[Foksh]

أخي الكريم @nssj ، بداية دعني أوضح لك نقاط مهمة في الدوال التي تعمد على البحث داخل سجلات عن قيم غير ثابتو ولا تتبع اسلوب محدد في موضعها ، فإنه مع كثيرة السجلات والبيانات في الجداول مستقبلاً ستأخذ وقتاً أوطول كلما زادت كميوة الداتا في الجدول المستهدف للبحث فيه . وهذا أمر طبيعي ، وسأحاول جاهداً توظيف الكود ليكون سلساً وسهلاً في آلية عمله .

 

ثانياً ، اعذرني لأني أحيانا لا أدقق في النتائج بشكل ممعن كصاحب الموضوع 

 

على العموم ، جرب هذا التعديل البسيط لجعل الكود بعتمد البحث عن الرقم بطريقتين:-

الأولى حيث يتبع الرقم مباشرة اسم الكتاب، والثانية حيث يكون الرقم موجودًا داخل النص دون الالتزام بموضع محدد ، في الكود التالي ، وأخبرني بالنتيجة سريعاً

 

الكود :

    Dim db As DAO.Database
    Dim rsBooks As DAO.Recordset
    Dim rsTab As DAO.Recordset
    Dim sql As String
    Dim bookNumber As String
    Dim found As Boolean
    Set db = CurrentDb()
    Set rsBooks = db.OpenRecordset("BOOKS")
    Do While Not rsBooks.EOF
        bookNumber = rsBooks!B_Hno
        found = False
        sql = "SELECT * FROM TAB WHERE NASS LIKE '" & rsBooks!bookName & " " & bookNumber & "%'"
        Set rsTab = db.OpenRecordset(sql)
        If Not rsTab.EOF Then
            rsTab.MoveFirst
            Do While Not rsTab.EOF
                If InStr(rsTab!NASS, bookNumber) = Len(rsTab!bookName) + 2 Then
                    rsBooks.Edit
                    rsBooks!MNO = rsTab!MNO
                    rsBooks.Update
                    found = True
                    Exit Do
                End If
                rsTab.MoveNext
            Loop
        End If
        
        If Not found Then
            sql = "SELECT * FROM TAB WHERE InStr(NASS, '" & bookNumber & "') > 0"
            Set rsTab = db.OpenRecordset(sql)
            
            If Not rsTab.EOF Then
                rsTab.MoveFirst
                Do While Not rsTab.EOF
                    If InStr(rsTab!NASS, bookNumber) > 0 Then
                        rsBooks.Edit
                        rsBooks!MNO = rsTab!MNO
                        rsBooks.Update
                        found = True
                        Exit Do
                    End If
                    rsTab.MoveNext
                Loop
            End If
        End If
        rsTab.Close
        Set rsTab = Nothing
        rsBooks.MoveNext
    Loop
    rsBooks.Close
    Set rsBooks = Nothing
    Set db = Nothing

المرفق بعد التعديل :-

 

Smart_Search03.accdb

[nssj]

أخي الكريم .. لا تزال الأخطاء نفسها

لابد من البحث عن الرقم كاملا حتى لا يحصل خلط بين : (312) (1312) وأمثالها

ولا بد من البحث عن الرقم بعد اسم الكتاب وإلا ستكون الأخطاء كبيرة

تأكدت من هذا بعد التجربة على الملفات الأصلية

لأنه توجد الكثير من الأرقام .. مثلا هذا الحديث في أوائل الملف الأصلي

إذا كان البحث عن الرقم فقط فستعتمد الدالة رقم هذا الحديث عند البحث عن كل حديث رقمه (5) أو (113) أو (114) أو (66) أو (185) أو (293) أو (706) .. ..

[Ahmos]

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

صبحكم الله بالخير والنور والسرور
بارك الله فيكم وفي جهودكم الطيبة
أخي الكريم جرب هذا الكود "إن شاء الله يعمل معك"
عند التطبيق وجدت اختلاف في قيمة واحدة وهي بالصورة التالية:

Public Sub mnoSmartSearch()

    Dim db              As DAO.Database
    Dim rs              As DAO.Recordset
    Dim tabRS           As DAO.Recordset
    Dim sqlStr          As String
    Dim tblName         As String
    Dim foundMno        As String
    Dim totalRec        As String
    Dim exNum           As String
    Dim stext           As String
    Dim sPos            As Long
    Dim startPos        As Long
    Dim endPos          As Long
    Dim i               As Long
    
    tblName = "BOOKS"
    
    If DCount("*", tblName) = 0 Then
        MsgBox "There are no records in the table " & tblName, vbExclamation + vbOKOnly, "No Records Exist Error"
        Exit Sub
    End If
    
    Set db = CurrentDb

    Set rs = db.OpenRecordset(tblName, dbOpenDynaset)
    With rs
        .MoveLast
        .MoveFirst
        totalRec = .RecordCount
        Do While Not .EOF
            sqlStr = ""
            foundMno = ""
            If Not IsNull(!BookName) And Not IsNull(!B_Hno) Then
                sqlStr = "SELECT TAB.MNO, TAB.NASS " & _
                        "FROM TAB " & _
                        "WHERE TAB.NASS LIKE '*" & Nz(!BookName, "") & "*' " & _
                        "AND InStr([NASS],'" & Nz(!B_Hno, "") & "') > 0;"
                Set tabRS = db.OpenRecordset(sqlStr, dbOpenSnapshot)
                tabRS.MoveLast
                tabRS.MoveFirst
                If tabRS.RecordCount = 0 Then
                    ' No Results found
                    Debug.Print "NotFound", !BookName, !B_Hno
                ElseIf tabRS.RecordCount = 1 Then
                    ' One Result Found and that what we want
                    foundMno = Nz(tabRS!MNO, "")
                    If foundMno <> "" Then
                        .Edit
                        !MNO = foundMno
                        .Update
                    End If
                Else
                    ' more than one record found and that shouldn't happen
'                    Debug.Print "Found Times is : " & tabRS.RecordCount, rs!BookName, rs!B_Hno
                    Do While Not tabRS.EOF
                        sPos = 0
                        i = 0
                        startPos = 0
                        endPos = 0
                        exNum = ""
                        stext = ""
                        
                        stext = tabRS!NASS
                        sPos = InStr(1, stext, rs!B_Hno)
                        
                        i = sPos
                        Do While i > 0 And IsNumeric(Mid(stext, i, 1))
                            i = i - 1
                        Loop
                        startPos = i + 1
                        
                        ' Move forward to find the end of the number
                        i = sPos
                        Do While i <= Len(stext) And IsNumeric(Mid(stext, i, 1))
                            i = i + 1
                        Loop
                        endPos = i - 1
                        
                        exNum = Mid(stext, startPos, endPos - startPos + 1)
                    
                        If rs!B_Hno = exNum Then
                            .Edit
                            !MNO = Nz(tabRS!MNO, "")
                            .Update
                            Exit Do
                        End If
                    tabRS.MoveNext
                    Loop
                End If

                If Not tabRS Is Nothing Then
                    tabRS.Close
                    Set tabRS = Nothing
                End If

            Else
                ' BookName or B_Hno are Empty
                Debug.Print "BookName or B_Hno are Empty"
            End If
        
        .MoveNext
    If totalRec Mod 1000 = 0 Then DoEvents
    Loop
    End With
    If Not rs Is Nothing Then
        rs.Close
        Set rs = Nothing
    End If
    If Not db Is Nothing Then Set db = Nothing
End Sub

 

[nssj]

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

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

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

[Ahmos]

أرجو لك من الله التوفيق

وبانتظار نتائج تجاربك

لقد قمت بالتعديل علي الملف الأخير الذي قمت بمشاركته

1- اضفت موديول لحساب الوقت حتي تتمكن من حساب وقت العملية

2- قمت بالتطبيق علي الكود ( It Takes | 14MS | To resolve | 21 | Records. )

3- قمت بتعديل (

Dim totalRec        As String

) إلي (

Dim totalRec        As Long

)

النسخة بالمرفقات

والأكواد المعدلة في أخر الموضوع

كما أود الإشارة الي هذا السطر في الكود

If totalRec Mod 1000 = 0 Then DoEvents

وظيفته بشكل مختصر هي توقف تنفيذ الكود كل 1000 سجل حتي يتمكن البرنامج من التحرر وتلقي التحديثات ويحد من مشكلة عدم الاستجابة "Not Responding"

لذا يمكنك التعديل علي الرقم 1000 بما يتناسب مع استخدامك مع الاخذ في الاعتبار ان هذا يؤثر علي الوقت الإجمالي للعملية
يوجد فيديوهات تشرح الامر بالتفصيل ( 

كما يمكنك الاطلاع علي الرابط التالي

https://wellsr.com/vba/2018/excel/vba-doevents-and-when-to-use-it/
 

1- Timer Class MODULE ATTACHED

2- الكود بعد التعديل وتطبيق استخدام (Timer Class MODULE)

Public Sub mnoSmartSearch()

    Dim db              As DAO.Database
    Dim rs              As DAO.Recordset
    Dim tabRS           As DAO.Recordset
    Dim tblName         As String
    Dim sqlStr          As String
    Dim foundMno        As String
    Dim exNum           As String
    Dim stext           As String
    Dim totalRec        As Long
    Dim sPos            As Long
    Dim startPos        As Long
    Dim endPos          As Long
    Dim i               As Long
    Dim sTimer          As ahmosTimer
    Dim itTakes         As String
    
    
    tblName = "BOOKS"
    
    If DCount("*", tblName) = 0 Then
        MsgBox "There are no records in the table " & tblName, vbExclamation + vbOKOnly, "No Records Exist Error"
        Exit Sub
    End If
    
    Set sTimer = New ahmosTimer
    sTimer.StartTimer
    
    Set db = CurrentDb

    Set rs = db.OpenRecordset(tblName, dbOpenDynaset)
    With rs
        .MoveLast
        .MoveFirst
        totalRec = .RecordCount
        Do While Not .EOF
            sqlStr = ""
            foundMno = ""
            If Not IsNull(!BookName) And Not IsNull(!B_Hno) Then
                sqlStr = "SELECT TAB.MNO, TAB.NASS " & _
                        "FROM TAB " & _
                        "WHERE TAB.NASS LIKE '*" & Nz(!BookName, "") & "*' " & _
                        "AND InStr([NASS],'" & Nz(!B_Hno, "") & "') > 0;"
                Set tabRS = db.OpenRecordset(sqlStr, dbOpenSnapshot)
                tabRS.MoveLast
                tabRS.MoveFirst
                If tabRS.RecordCount = 0 Then
                    ' No Results found
                    Debug.Print "NotFound", !BookName, !B_Hno
                ElseIf tabRS.RecordCount = 1 Then
                    ' One Result Found and that what we want
                    foundMno = Nz(tabRS!MNO, "")
                    If foundMno <> "" Then
                        .Edit
                        !MNO = foundMno
                        .Update
                    End If
                Else
                    ' more than one record found and that shouldn't happen
'                    Debug.Print "Found Times is : " & tabRS.RecordCount, rs!BookName, rs!B_Hno
                    Do While Not tabRS.EOF
                        sPos = 0
                        i = 0
                        startPos = 0
                        endPos = 0
                        exNum = ""
                        stext = ""
                        
                        stext = tabRS!NASS
                        sPos = InStr(1, stext, rs!B_Hno)
                        
                        i = sPos
                        Do While i > 0 And IsNumeric(Mid(stext, i, 1))
                            i = i - 1
                        Loop
                        startPos = i + 1
                        
                        ' Move forward to find the end of the number
                        i = sPos
                        Do While i <= Len(stext) And IsNumeric(Mid(stext, i, 1))
                            i = i + 1
                        Loop
                        endPos = i - 1
                        
                        exNum = Mid(stext, startPos, endPos - startPos + 1)
                    
                        If rs!B_Hno = exNum Then
                            .Edit
                            !MNO = Nz(tabRS!MNO, "")
                            .Update
                            Exit Do
                        End If
                    tabRS.MoveNext
                    Loop
                End If

                If Not tabRS Is Nothing Then
                    tabRS.Close
                    Set tabRS = Nothing
                End If

            Else
                ' BookName or B_Hno are Empty
                Debug.Print "BookName or B_Hno are Empty"
            End If
        
        .MoveNext
    If totalRec Mod 1000 = 0 Then DoEvents
    Loop
    End With
    If Not rs Is Nothing Then
        rs.Close
        Set rs = Nothing
    End If
    If Not db Is Nothing Then Set db = Nothing
    
    sTimer.StopTimer
    itTakes = sTimer.GetElapsedTime
    If Not sTimer Is Nothing Then Set sTimer = Nothing

    Debug.Print "It Takes | " & itTakes & " | To resolve | " & totalRec & " | Records."
End Sub

 

Smart_Search03_byAhmos.accdb ahmosTimer.zip

[nssj]

جزاك الله خيرا أخي الكريم .. وأنا بحاجة لوقت لاستيعاب هذه المستجدات .. والآن تركيزي على التجارب

بعد التجربة على ملف أكبر قليلا خرجت هذه الرسالة

وبقي (188) حديثا من أصل (282) لم يعمل فيها الكود

وعند مراجعة نتائج ما عمل فيه الكود ظهرت بعض الأخطاء التي مرجعها إلى وجود الرقم المطلوب قبل اسم الكتاب

لذلك لا بد من البحث عن الرقم بعد اسم الكتاب وما قبله لا اعتبار له

لذلك انا عندما كنت أجري التجارب الأولية -لكوني أعشق التجارب- خطر على بالي إعداد نص خاص للبحث يحذف كل النص الذي قبل اسم الكتاب المطلوب ليكون البحث فيما بعده، وهذا يقتضي أن أعد نصا خاصا لكل اسم كتاب .. وهذا حل غير عملي بالطبع 😁

[Ahmos]

بالنسبة لرسالة الخطأ الاولي
فيمكن حلها بأكثر من طريقة

استبدل الكود

tabRS.MoveLast
                tabRS.MoveFirst

بهذا

 

On Error Resume Next
                tabRS.MoveLast
                tabRS.MoveFirst
                On Error GoTo 0

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

في حال كان هناك أكثر من ناتج اقم بتحديد موقع الرقم ومن ثم اذهب الي الوراء حتي اجد اول الرقم ومن ثم اذهب للأمام حتي اجد اخر الرقم
وذلك حتي نتمكن من استخراج الرقم ومقارنته بالرقم الأصلي فاذا تطابق  نعتمد هذا الناتج وذلك حتي نستطيع التمييز بين 312 و 1312

اذا امكنك مشاركة قاعدة بها احتمالات أكثر حتي نحاول بإذن الله من إيجاد حلول مناسبة

[nssj]

أخي الكريم .. في الملف الجديد المرفق أمثلة يظهر فيها أهمية أن يكون البحث بعد اسم الكتاب

وبخلاف ذلك ستحدث الأخطاء

الأرقام الصحيحة في حقل (MNOX)

وعدد الأخطاء في الملف (8) وكلها لنفس السبب

وقد ميزتها بعلامة (1select)

وهذا أحدها

 

 

الدالة بحثت أولا عن اسم الكتاب (الطيوريات) ثم بحثت عن الرقم المطلوب وهو (135)

ووجدتهما في (TAB) في الحديث رقم (30731)

ولكنه ليس هو المطلوب

لأن الرقم (135) الذي تم إيجاده ليس هو رقم الحديث في كتاب الطيوريات وإنما رقما لحديث في كتاب آخر ذُكر قبله

قد يعد هذا الأمر مصادفة .. ولكنها كثيرة الحدوث

لا بد من البحث عن الرقم بعد اسم الكتاب

والرقم الصحيح للحديث المطلوب كما في حقل (MNOX) هو : (62993)

ويمكن استعراض أحاديث (BOOKS) وما يقابلها من الملف الرئيسي (TAB)  من خلال نموذج (BOOKS)

وبالنقر المزدوج على رقم (MNOX) يظهر الحديث الصحيح المطلوب

Smart_Search_New01.accdb

تم تعديل يونيو 2 بواسطه nssj

[Ahmos]

بعد مراجعة هذا الجزء مرة أخرى

اقتباس

لذلك لا بد من البحث عن الرقم بعد اسم الكتاب وما قبله لا اعتبار له

لذلك انا عندما كنت أجري التجارب الأولية -لكوني أعشق التجارب- خطر على بالي إعداد نص خاص للبحث يحذف كل النص الذي قبل اسم الكتاب المطلوب ليكون البحث فيما بعده، وهذا يقتضي أن أعد نصا خاصا لكل اسم كتاب .. وهذا حل غير عملي بالطبع 😁

هذا يمكن الوصل اليه إن شاء الله أثناء عملية البحث
ولكني اريد معرفة الاحتمالات التي قد نوجهها حتي نحاول إن شاء الله ان نصل الي تصور مناسب
لان كما فهمت أيداً ان عنصر الوقت مهم
علي سبيل المثال يمكن استخدام وظيفة كهذه لتقطيع النص
 

Public Function cutString(ByVal fullText As String, _
                            ByVal cutBy As String, _
                            Optional ByVal lrSide As String = "leftSide") As String
                            
    On Error GoTo ErrorHandler
    
    If fullText = "" Then
        'Debug.Print "Error: fullText is empty"
        cutString = ""
        Exit Function
    End If
    
    If cutBy = "" Then
        'Debug.Print "Error: cutBy is empty"
        cutString = fullText
        Exit Function
    End If
    
    If Len(cutBy) > Len(fullText) Then
        'Debug.Print "Error: cutBy is longer than fullText"
        cutString = fullText
        Exit Function
    End If
    

    Select Case LCase(lrSide)
        Case "leftside", "rightside"
            
        Case Else
            'Debug.Print "Warning: Invalid lrSide value '" & lrSide & "'. Using default 'leftSide'."
            lrSide = "leftSide"
    End Select
    

    Dim position As Long
    position = InStr(1, fullText, cutBy, vbTextCompare)
    
    If position > 0 Then
        Select Case LCase(lrSide)
            Case "leftside"
                cutString = Mid(fullText, position)
                'Debug.Print "Info: Returning left side from '" & cutBy & "'"
            Case "rightside"
                cutString = Left(fullText, position + Len(cutBy) - 1)
                'Debug.Print "Info: Returning right side up to '" & cutBy & "'"
        End Select
    Else
        'Debug.Print "Warning: '" & cutBy & "' not found in fullText. Returning original string."
        cutString = fullText
    End If

ExitFunction:
    Exit Function

ErrorHandler:
    Select Case Err.Number
        Case 13 ' Type mismatch
            Debug.Print "Error 13: Type mismatch. Ensure all arguments are strings."
        Case 5  ' Invalid procedure call or argument
            Debug.Print "Error 5: Invalid argument. Check the function call."
        Case Else
            Debug.Print "Unexpected Error " & Err.Number & ": " & Err.Description
    End Select
    cutString = fullText
    Resume ExitFunction
End Function

ويمكن استخدامها مباشرةً
باستبدال هذا الجزء من الكود
 

sqlStr = "SELECT TAB.MNO, TAB.NASS " & _
                        "FROM TAB " & _
                        "WHERE TAB.NASS LIKE '*" & Nz(!BookName, "") & "*' " & _
                        "AND InStr(cutString([NASS],'" & Trim(!BookName) & "','leftSide'),'" & Nz(!B_Hno, "") & "') > 0;"

ولكن زاد وقت المعالجة
إلي 
It Takes | 661MS | To resolve | 21 | Records.

 

 

لقد كنت أجهز للمشاركة ولم اري ردك
شوف اقم بالتجربة
وسأنتظر ردك بعد تجربة الوظيفة والاضافة الجديدة

[nssj]

النتائج الخاطئة كانت (8) أصبحت بهذه الإضافة (6)

وبالنسبة للوقت .. فيبدو أني أخطأت في التعبير .. مشكلتي كانت أن الدالة أخذت الكثير من الوقت عدة ساعات ولم تتوقف .. مما أجبرني على إيقافها .. يعني أنها (علقت) 🙂

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

ثانيا.. أخي الكريم، أنا أريد دالة توفر لي الوقت للحصول على أفضل النتائج الممكنة، وسوف أقوم بمراجعة النتائج

وأعلم أنه لا يمكن الحصول على نتائج دقيقة 100%

توجد في الملف عدة تعقيدات تحول حتى دون الوصول إلى نتائج بنسبة 70% في تقديري

ولكن أسعى للحصول على الأفضل قدر الإمكان لتسهيل المراجعة

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

 

هذا الطلب يحل لي مشكلة، لكنه يوقعني في مشكلة أخرى

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

كما في هذا المثال

 

إذا كان المطلوب البحث عن معجم ابن عساكر (611)، فسيخرج هذا الحديث لوجود الرقم (611) بعد اسم الكتاب بعدة أسطر

ويوجد عدة أمثلة لهذه الظاهرة

لكن في تقديري أن الإبقاء على خاصية البحث عن الرقم ولو كان بعد اسم الكتاب بعدة أسطر فائدتها أكبر من مضارها

وكما ذكرت .. توجد تعقيدات أخرى سوف تتسبب بخطأ في النتائج .. لكن إذا تجاوزنا مشكلة البحث عن الرقم بعد اسم الكتاب فقط وليس قبله، كما تجاوزنا مشكلة البحث عن الرقم كاملا .. فأنا راض بالنتيجة .. والله الميسر

 

[Ahmos]

دلوقتي عملت تعديل
بعد حذف الجزء ما قبل اسم الكتب والبحث عن الرقم في الجزء المتبقي
ظهرت الحالة التالية

فمحاولتي الان هي ان يتم التميز بين النتائج واختيار الرقم الأقرب لأسم الكتاب

هذه هي الفكرة التي أعمل عليها الان حتي نتأكد من اختيار الناتج الصحيح

ولكن عندي سؤال

هل دائماً نبحث عن الرقم لو قد نبحث عن 73/2 

 

 

[Ahmos]

في فكرة تانية جت فدماغي
دلوقتي ان شاء الله الفكرة دي هتضمنلك نتيجة 100% بإذن الله

1- عايزين نحذف ما قبل اسم الكتاب وما بعد الرقم
2- الجزء المتبقي معانا هيبقي فيه احتمالين

- ان يكون في اسم كتاب تاني

- او مفيهوش
وفالحالة دي احنا ناخد اللي مافيهوش اسم كتاب تاني
وده هشان نحل مشكلة الارقام اللي بتيجي فمواضع متاخرة

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

 

إن شاء الله هتظبط وهتدعيلي

[nssj]

جزاك الله خيرا على اهتمامك

لكن أنا رأيي إنو نركز أولا على مشكلة البحث عن الرقم بعد اسم الكتاب وليس قبله

وإذا زبطت بعون الله .. نشوف الموضوع الثاني

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

فهل موافقتك على هذه الطريقة تعني إنو ما في طريقة أخرى لتأدية المطلوب ؟؟

وإذا كنت تريد حذف ما قبل اسم الكتاب فهذا يعني أن الدالة ستنتج نص خاص للبحث عن كتاب (معجم ابن عساكر) وبعد الانتهاء منه تماما تنشئ نص آخر خاص للبحث عن (فوائد تمام) .. وهكذا لجميع الكتب ، لأنه توجد الكثير من الصفحات في (TAB) فيها أكثر من اسم كتاب كما هو ظاهر

[nssj]

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

هل دائماً نبحث عن الرقم لو قد نبحث عن 73/2 

عذرا أخي الكريم .. لم أنتبه لهذه المشاركة

وهذه أحد التعقيدات الكبيرة بالنسبة لي .. فهناك مجموعة لا بأس بها من الكتب التخريج المعتمد فيها ليس على الرقم ، بل على الجزء والصفحة، والمشكلة أنه قد يكون في الصفحة الواحدة أكثر من حديث

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

فإذا انتهيت منها .. فلكل حادث حديث