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

[Ahmos]

أخي الكريم تم عمل التعديل كالتالي

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

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

 فمثلاً في هذه الحالة

عندما أضفت اسم الكتاب الفوائد المعللة لأبي زرعة الي الجدول BOOKS
أصبحت النتيجة صحيحة

وهنا إذا اضفنا المجمع لقائمة الكتب ستصبح النتيجة صحيحة وهكذا ،،،

تم إضافة هذا الجزء حتي يقوم بمقارنة النتيجة بالرقم mnox ويقوم بعمل select1 true or false
 

If CStr(Nz(!MNO, "")) = CStr(Nz(!MNOX, "")) Then
            !select1 = True
        Else
            !select1 = False
        End If

 

أتمني ان يقوم هذا بالمطلوب

وكما أخبرتك سابقاً يفضل إضافة مثال يحتوي علي كل او معظم الحالات حتي نتمكن من وضع تصور يسمح بالتعامل مع أغلب الحالات قدر المستطاع

وفقك الله وحفظك

بانتظار التجربة علي ملف يحتوي علي عدد كبير ويفضل ان يحتوي علي جميع أسماء الكتب

 

Smart_Search_New02.accdb

[Ahmos]

أخي الكريم إجابةً علي هل هناك طرق أخري

فحسب معلوماتي يوجد طريقة أخري عني طريق تحديد أنماط للبحث داخل النص
باستخدام (regEx)

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

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

ومن ثم إذا كانت نتيجة التصفية 1 فلا يوجد مشكلة وهنا تطابق 100%
اما اذا كانت أكثر نقوم بالبحث داخل هذه النتائج فإن كان هناك اسم كتاب أخر بين اسم الكتاب والرقم فهذا يعني بان الرقم يخص الكتاب الأخر فنستبعد هذا الاحتمال

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

والاضافة الحالية التي قد تساعدك ان نقوم بإضافة عمود نضع فيه عدد النتائج التي ظهرت في التصفية
وعمود أخر نجمع في ارقام الـ MNO الخاصة بهذه النتائج حتي نقلص وقت المراجعة

 

 

تم تعديل يونيو 3 بواسطه Ahmos
حذف رد مكرر + إضافة رد جديد

[nssj]

بارك الله فيك أخي الكريم

بعد أن أضفت (المجمع) لقائمة الكتب كانت النتائج الخاطئة = 0

وجربت الكود على المجموعة القديمة التي بدأت بها هذا الموضوع وكانت النتائج الخاطئة = 0

وهذه نتيجة مبشرة بحمد الله

وأنا الآن لدي بعض الأشغال خارج البيت ولا مجال للتجارب على الملفات الكبيرة الآن

ولكن هل يساعد أن أعطيك قائمة بأسماء الكتب

أنا عندي قائمة منفصلة بأسماء الكتب ..  فيها أكثر (360) كتابا إلى الآن !! .. وهي في الملف المرفق

BOOKSLIST.accdb

[Ahmos]

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

أخي الكريم بارك الله فيك، إليك نسخة محسنة مع بعض الإضافات التي قد نحتاج إليها مستقبلاً "بالمرفقات"

- تم إزالة الاكواد الزائدة

- تم تعديل الوظيفة الخاصة بقص النص وإضافة بعض المميزات

- تم إضافة جدول أسماء الكتب

إليك بعض التوضيحات

1- الكود المسؤول عن إضافة أسماء الكتب للكولكشين هو "createBooksCollection"

ويمكن التعديل عليه لتغير المصدر الخاص بأسماء الكتب من خلال التعديل علي
 

اسم الجدول : booksSourceTable = "BOOKSLIST"
اسم العمود : booksColumn = "BookName"

يتم تطيبق هذا الاجراء داخل الكود الاساس من خلال هذه الاكواد

1- يجب تعريف الكوليكشين 

Dim BooksCollection As Collection

ثم التطبيق

createBooksCollection BooksCollection

2- تم تعديل الوظيفة الخاصة بالنص حتي تسمح بالاتي
هي فالاول كانت تقوم بالبحث عن اول الكلمة (إسم الكتاب) ثم تبحث عن أخر رقم مطابق
الان التعديلات هي
1- البحث عن أقرب رقم مطابق وهو الافتراضي 
2- البحث عن أخر رقم مطابق

3- إمكانية إضافة نص أختياري بعد الرقم المطابق

مثال

Sub TestTrimString()
    Dim fullText    As String

    fullText = "I have too many books contain this subject book 35 and book 353 and book 35/4 and book 135 search in any"
    ' حتي نحصل علي أقرب نتيجة مطابقة
    Debug.Print trimString(fullText, "books", "35")
    ' حتي نحصل علي أبعد نتيجة مطابقة
    Debug.Print trimString(fullText, "books", "35", False)
    ' حتي نحصل علي أقرب نتيجة مطابقة ثم نضيف 4 خانات من النص الاساسي
    Debug.Print trimString(fullText, "books", "35", True, 4)
	' حتي نحصل علي أبعد نتيجة مطابقة ثم نضيف 5 خانات من النص الاساسي
	Debug.Print trimString(fullText, "books", "35", False, 5)
End Sub

هذه الأكواد متعلقة بوجود العمود MNOX وكما فهمت هذا العمود لن يكون موجود تم وضعه للأختبار فقط

لذا يجب  تعليق هذه الاكواد في حالة عدم وجودة

If CStr(Nz(!MNO, "")) = CStr(Nz(!MNOX, "")) Then
            !select1 = True
        Else
            !select1 = False
        End If

Debug.Print "Total Match is " & DCount("[select1]", "BOOKS", "[select1]=True") & " / " & DCount("*", "BOOKS") & " Total Records"

تم إضافة هذا الكتاب لجدول الكتب

 

تم إضافة العمود الخاص بعدد النتائج والعمود الخاص بجميع الـ MNO بها

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

It Takes | 78MS | To resolve | 33 | Records
لمعرفة كم احتاجت من الوقت

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

 

Smart_Search_NSSJ.accdb

[nssj]

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

أجريت تجربة على ملف كبير، والنتيجة أكثر من جيدة بحمد الله

من حيث الوقت لم تأخذ إلا بضع دقائق

والنتائج إلى الآن دقيقة .. ولا أزال في طور المراجعة العشوائية

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

 أحد هذه التعقيدات يمكن تجاوزها بعملية استبدال في نص الجدول (TAB)

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

-  مصنفات ابن البختري 237- (38) حدثنا محمد بن عبدك القزاز قال: حدثنا أبوبلال قال: حدثنا قيس بن الربيع

- حديث شعبة لابن المظفر 213 - (153) حدثنا عبد الملك بن علي بن محمد بن مكرم

- المخلصيات 1079- (60) حدثنا عبدالله قال: حدثنا حميد بن مسعدة الشامي

 

فعند البحث عن كتاب (مصنفات ابن البختري) حديث رقم (38)، فستخرج النتيجة التالية: 

وليست هي النتيجة المطلوبة، النتيجة المطلوبة:

 

* ولتجاوز هذا الأمر فأنا بحاجة إلى دالة منفصلة لحذف كل الأرقام التي تكون بين قوسين بشرط وجودها بعد [رقم& مسافة أو بدون مسافة& - & مسافة أو دون مسافة]

يعني تصبح الأرقام السابقة كالتالي

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

- حديث شعبة لابن المظفر 213 - حدثنا عبد الملك بن علي بن محمد بن مكرم

- المخلصيات 1079- حدثنا عبدالله قال: حدثنا حميد بن مسعدة الشامي

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

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

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

ولكن استوقفني هذا الحديث الذي لم يجده

 

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

[nssj]

يبدو أننا أضفنا المشاركة في نفس الوقت

بعد تجربة الملف الجديد فالحديث الأخير الذي لم تجده الدالة السابقة وجدته الدالة الجديدة 🙂

[nssj]

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

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

It Takes | 41M:37.104S | To resolve | 9970 | Records
Total Match is 4563 / 9970 Total Records

ستتوقف تجاربي الآن لبعض المشاغل

وبانتظار دالة حذف الأرقام بين قوسين .. إن أمكن

حتى أعالج بعض الأمور في الملف لإجراء التجربة الكبرى على الملفات الرئيسية

[nssj]

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

إمكانية إضافة نص أختياري بعد الرقم المطابق

هذا الكلام جعلني أفكر وأنا في السيارة .. هل يمكن إضافة اسم ثاني للكتاب للبحث عنه إن كانت نتيجة البحث عن الاسم الأول صفر

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

جزء الصفار = جزء إسماعيل الصفار

أمالي ابن بشران = ابن بشران في أماليه

معجم ابن عساكر = ابن عساكر في معجمه

وهكذا .. فإن كان بالإمكان إضافة عمود في جدول قائمة الكتب : bookname2

توضع فيه هذه الأسماء عند اللزوم

بحيث إن لم تجد الدالة أي نتيجة تعيد البحث باستخدام الاسم الثاني إذا كان موجودا في القائمة

هذا من شأنه أن يقلل من النتائج غير الموجودة

[Ahmos]

نعم أخي الكريم يمكن عمل ذلك ولكن أفضل تطبيقه بالطريقة التالية

الأجراء الحالي كما هو ثم نقوم بعمل إجراء أخر يبدأ بالتحقق من الخانات الفارغة بالعمود mno 
ومن ثم يذهب للقيمة بـ Bookname2  والرقم

والحمد لله ان ما قلته قد اوحي لك بهذه الفكرة مع ان المقصود من كلامي بعيد كل البعد عن هذه الفكرة 😁

فالمقصود بإضافة نص اختياري هنا الاتي

لنفترض ان لدينا النص التالي "كل الكتاب المتاحة في المكتبة هي 4000 كتاب وفي مجال الحديث 2000 كتاب"
إذا اردنا قص النص باستخدام الوظيف 
فيجب تحديد نقطة البداية ونقطة النهاية دائماً رقم

فمثلاً البداية مع كلمة الكتاب والنهاية مع الرقم 4000 فستقوم الوظيفة بذلك ولكن ماذا لو اردنا ان نزيد علي القص بعض الخانات الاضافية

فيكون الاستخدام هكذا 

trimString("fullText","الكتاب","4000",True,5)

وتكون النتيجة

الكتاب المتاحة في المكتبة هي 4000 كتاب

إذا طبقت المثال بالمشركة السابق سيتضح الأمر إن شاء الله

تصورت بهذه الطريقة قد نحتاج إلي زيادة بعض الخانات الإضافية التي قد نحتاج إليها في البحث او التمييز

بالنسبة لطلبك الأخر

اقتباس

* ولتجاوز هذا الأمر فأنا بحاجة إلى دالة منفصلة لحذف كل الأرقام التي تكون بين قوسين بشرط وجودها بعد [رقم& مسافة أو بدون مسافة& - & مسافة أو دون مسافة]

الحمد لله والشكر لله تم التوصل للمطلوب 
يتم البحث اولاً عن جميع الارقام المطابقة بنسبة 100 ومن ثم التحقق إذا كان يسبق الرقم )- او ) - يتم إستبعاد الرقم من النص الكلي
وجاري العمل علي التطبيق وسيتم المشاركة قريباً إن شاء الله

 

 

[Ahmos]

أخي الفاضل 
عندما قمت بتطبيق الوظيفة الجديدة تبين ما يلي

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

 

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

[nssj]

23 دقائق مضت, Ahmos said:

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

النتيجة التي كانت ظاهرة (32901) غير صحيحة، النتيجة الصحيحة للحديث رقم (25) من مصنفات ابن البختري هي: (59509) ولم تظهر لأن هذا الحديث غير موجود في الجدول المرفق أصلا

الخلاصة: نتيجة الدالة صحيحة حسب المعطيات

ثم إن المثال الذي ذكرته: مصنفات ابن البختري (15)، و269- (25) حدثنا محمد بن الحسين بن أبي الحنين ..

ليس رقمه في مصنفات ابن البختري هو (25)، له رقمان الأول (15) والثاني (269) وهكذا هو في الملف المرفق

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

مصنفات البختري (15)، و269 - حدثنا محمد ..

[Ahmos]

النص بعد حذف الأرقام أصبح

مصنفات البختري (15)، و269 - () حدثنا محمد ..

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

Smart_Search_NSSJ_V2.accdb

[Ahmos]

[nssj]

تمام أخي الكريم .. النتائج دقيقة بحمد الله .. فجزاك الله خيرا

بانتظار إضافة البحث عن الاسم الثاني لبعض الكتب في الأحاديث التي لا نتائج لها

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

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

وسؤال جانبي صغير: كيف أستخدم كود حذف الأرقام لوحده إذا احتجت إليه، جربت

CurrentDb.Execute "UPDATE TAB SET TAB.NASS = wipeValueFormString([nass]);"

ولم تنجح 🙂

 

[Ahmos]

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

أخي الكريم هذه الدالة (wipeValueFormString) لا تعمل هكذا 

اقتباس

CurrentDb.Execute "UPDATE TAB SET TAB.NASS = wipeValueFormString([nass]);"

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

فتستخدم هكذا wipeValueFormString([nass],"25")
ولكن قد قمت بفضل الله بعمل ثلاث دوال أخرى تطابق الشروط التالية
تبحث عن - متبوعة بأي عدد من المسافات ثم ( وبعد ذلك يوجد محتوي كل دالة تتعامل مع المحتوي بشكل مختلف ثم )
مثال علي أحد الدوال وفرصة لعرض إمكانية Regex في التحقق من نمط بداخل نص وانا لم أتعمق كثيراً في استخدامتها ولكن أحتجتها قريباً وبدأت اقراء عنها وغالباً ما اعتمد فالبحث وأدوات الذكاء مؤخراً حتي أصل للنمط المناسب حتي وانا أبحث هذه المرة تعرفت علي معلومة جديد

Public Function wipeNumbersInCondition(ByVal fullText As String) As String
    Dim regex   As Object
    
    Set regex = CreateObject("VBScript.RegExp")
    
    With regex
        .Global = True
        .MultiLine = True
        .IgnoreCase = False
        .Pattern = "(-\s*\()(\d+)(\))"
    End With
    
    wipeNumbersInCondition = regex.Replace(fullText, "$1$3")
    If Not regex Is Nothing Then Set regex = Nothing
End Function

Public Function wipeAllInCondition(ByVal fullText As String) As String
    Dim regex   As Object
    
    Set regex = CreateObject("VBScript.RegExp")
    
    With regex
        .Global = True
        .MultiLine = True
        .IgnoreCase = False
        .Pattern = "(-\s*\()([\d/-]+)(\))"
    End With
    
    wipeAllInCondition = regex.Replace(fullText, "$1$3")
    If Not regex Is Nothing Then Set regex = Nothing
End Function

Public Function wipeAnyInCondition(ByVal fullText As String) As String
    Dim regex   As Object
    
    Set regex = CreateObject("VBScript.RegExp")
    
    With regex
        .Global = True
        .MultiLine = True
        .IgnoreCase = False
        .Pattern = "(-\s*\()([^)]*)(\))"
    End With

    wipeAnyInCondition = regex.Replace(fullText, "$1$3")
    If Not regex Is Nothing Then Set regex = Nothing
End Function

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

1- wipeNumbersInCondition تحذف المحتوي إذا كان ارقام فقط

2- wipeAllInCondition تحذف المحتوي إذا ارقام / ارقام

3- wipeAnyInCondition تحذف المحتوي مهما كان
 

مثال إذا أردت التعديل علي النمط حتي لا يبحث عن عدد لا نهائي من المسافات بين الـ - والـ ( اريدة فقط ان يبحث عن مسافة واحدة او بدون مسافات
كل ما علي فعله هو أستبدال \s* بـ \s? في النمط "(-\s*\()(\d+)(\))" حيث ان ؟ تعني بدون مسافة او مسافة واحد

والمعلومة الجديدة التي تعلمتها هي

هنا تتم عملية الاستبدال للنمط المطابق  regex.Replace(fullText, "$1$3")
ومن الممكن ان يتم الاستبدال هكذا  regex.Replace(fullText, "-()")

ولكن $1 يشير إلي أول جزء في النمط و $3 تشير الي الجزء الثالث في النمط وبتالي ستيم الاستبدال بالقبم الملتقطة فلن يتغير اي شي علي النص فقط المحتوي ما بين الـ ()

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

-------------------

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

بانتظار إجابتك

[nssj]

7 دقائق مضت, Ahmos said:

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

سأعمل على ذلك بعون الله

لكني الآن لا زلت أنتظر أن تنهي الدالة عملها

فقد جربت آخر تحديث الذي فيه دالة حذف الأرقام  على الملف الكبير الذي أخذ سابقا تقريبا (40) دقيقة

والآن الدالة تعمل منذ أربع ساعات ولم ينتهي العمل

وإذا كانت دالة الحذف تعمل على النص كله في كل عملية بحث فلعل هذا هو سبب التأخر

لذلك كنت أفضل دالة مستقلة لإعداد نص خاص للبحث في (TAB) بحيث يكون البحث دون حذف أو تعديل على النص

على شاكلة النص بدون تشكيل الذي أعددته لأغراض البحث

[Ahmos]

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

 

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

 

[nssj]

جزاك الله خيرا أخي الكريم على متابعتك معي رغم الطلبات والمطبات

أولا: بخصوص دالة الحذف، فهناك عندة أمور:

1 – أنا أفضل أن تكون دالة منفصلة أستخدمها أنا لإعداد نص البحث المطلوب (NASS)

بحيث ترجع الدالة للطريقة الأولى في البحث، تبحث في حقل (NASS) دوت إجراء أي تعديل عليه، لأنه معد مسبقا

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

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

لكن إذا لم يكن قبل الشرطة رقم فالأفضل عدم الحذف مثل:

 

3- جربت الدالات الثلاث، وانا سأختار الدالة الثالثة اتي تحذف كل ما بين القوسين

إلا إذا كان بالإمكان إجراء تعديل بحيث تحذف أي رقم بين القوسين، حتى لو تم الفصل بين الأرقام بـ (/) أو (،) (-) أو غير ذلك، مع مسافة أو بدون .. المهم حذف كل ما هو رقم بين القوسين

 

ثانيا: بخصوص إعداد ملف للبحث باعتبار الاسم الثاني للكتاب

هل يكفي وضع هذه الأسماء في في جدول قائمة الكتب (BOOKSLIST) وليس في جدول (BOOKS)، بحيث تحضره الدالة منه بدلالة رقم الكتاب (TableNo)

 

أم الأفضل وضعها أيضا في جدول (BOOKS) بجانب رقم الكتاب والاسم الأول

مع العلم أن جدول  (BOOKS) لم يكن فيه عمود خاص لأسماء الكتب (BookName)

وإنما وضعته أنا وتم تعبئته باستعلام تحديث من (BOOKSLIST) بدلالة (TableNo) ظنا منى أن هذا أفضل ليعمل الكود بسرعة .. فما هو رأيك أخي الكريم ؟

[Ahmos]

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

نبدأ من حيث انتهيت

بالنسبة للأسماء البديلة يجب انت تضافي في موضعين

1- في الجدول BOOKSLIST في نفس العمود BookName 
لان هذا العمود هو ما يضاف للكولكشين التي تقوم باستبعاد الكتب التي تقع بين اسم الكتاب الذي نبحث عنه ورقمه ان جاء متأخراً
2- يضاف العمود BookName2 في الجدول Books وكل اسم في العمود BookName يقابله البديل الخاص به في العمود BookName2

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

---------------------------------

بالنسبة لإمكانية التعديل علي النمط فهي متاحة إن شاء الله ولكن إريد منك حصر الاحتمالات بأمثلة ولو انت تكتبها
ك حديث 217 - (123,135) مثلاً إذا كان هناك عدد للأرقام لا يقل ولا يزيد عنه إذا كنت ترغب ان يتضمن الشرط عدد مسافات معينة
اريد أن أعلم الاحتمالات الممكن حتي نتمكن إن شاء الله من عمل نمط يستوعبها

--------------------------------

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

-----------------------------

بالتوفيق

[Ahmos]

اذا اردت ان تضيف العمود BookName2 بشكل منفصل في الجدول BOOKSLIST فلا يوجد مشكلة إن شاء الله ساعدل الوظيفة لتضيف منه ايضاً
ففي هذا الامر لا يهم الترتيب
ولكن يجب إضافته في الجدول BOOKS كما ذكرت سابقاً

[Ahmos]

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

Public Function nssjWipeNumbers(ByVal fullText As String) As String
    Dim regex   As Object
    
    Set regex = CreateObject("VBScript.RegExp")
    
    With regex
        .Global = True
        .MultiLine = True
        .IgnoreCase = False
        .Pattern = "(\d+\s*-\s*\()(\d+)(\))"
    End With
    
    nssjWipeNumbers = regex.Replace(fullText, "$1$3")
    If Not regex Is Nothing Then Set regex = Nothing
End Function

Public Function nssjWipeCondition(ByVal fullText As String) As String
    Dim regex   As Object
    
    Set regex = CreateObject("VBScript.RegExp")
    
    With regex
        .Global = True
        .MultiLine = True
        .IgnoreCase = False
        .Pattern = "(\d+\s*-\s*\()([\d-/_,\\]+)(\))"
    End With
    
    nssjWipeCondition = regex.Replace(fullText, "$1$3")
    If Not regex Is Nothing Then Set regex = Nothing
End Function

Public Function nssjWipeAny(ByVal fullText As String) As String
    Dim regex   As Object
    
    Set regex = CreateObject("VBScript.RegExp")
    
    With regex
        .Global = True
        .MultiLine = True
        .IgnoreCase = False
        .Pattern = "(\d+\s*-\s*\()([^)]*)(\))"
    End With

    nssjWipeAny = regex.Replace(fullText, "$1$3")
    If Not regex Is Nothing Then Set regex = Nothing
End Function

 

[nssj]

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

هذا الملف للعمل على البحث باعتبار الاسم الثاني للكتاب

Smart_Search_New04.accdb

[Ahmos]

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

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

بالتوفيق

 

Smart_Search_Nssj_V4.zip

[Ahmos]

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

وذلك بإضافة  |  \s*  |  للمقطع الأوسط 

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

Public Function nssjWipeCondition(ByVal fullText As String) As String
    Dim regex   As Object
    
    Set regex = CreateObject("VBScript.RegExp")
    
    With regex
        .Global = True
        .MultiLine = True
        .IgnoreCase = False
        .Pattern = "(\d+\s*-\s*\()([\d-/_,\s*\\]+)(\))"
    End With
    
    nssjWipeCondition = regex.Replace(fullText, "$1$3")
    If Not regex Is Nothing Then Set regex = Nothing
End Function

 

Smart_Search_Nssj_V5.zip

[nssj]

أحسن الله إليك أخي الكريم وجزاك خير الجزاء

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

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

أما النتائج التي لم تذكر فالقليل منها لنفس الأسباب السابقة، وأكثرها لأن هذه الكتب التي ام تخرج نتيجتها هي الكتب التي تخرج بالاعتماد على الجزء والصفحة (1/ 12 – 2/ 325 ..) وليس على الرقم

وبالنسبة لي فقد أحسنت وأفضلت، وتم ما طلبته

لكن إن كان عندك استعداد لإجراء تعديلين على الكود لبعض الاستخدامات الخاصة لبعض الكتب

هي ليست تعديلات ، بل اختصار لبعض الإجراءات

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

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

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

فإن كانت هذه الطلبات ممكنة فسأعد جدولا مناسبا لهذا الغرض

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

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

جربتها .. وهي تفي بالمطلوب والحمد لله