التعرف على الاسماء في نص

[قاسم اللبناني]

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

مثلا

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

ولو بأستخدام جدول أسماء فردية ( خالد - محمد - على، ) كمفهرس للتعرف على الأسماء بواسطته وتركيبها كأسماء رباعية أو ثلاثية او ثنائية حسب ما وردت في  النص 

واذا توفر اكثر من اسم كيف يتم تعبئة الاول لمطابقة الاسم الثاني  

 

[Eng.Qassim]

لا اجزم باني فهمت السؤال بالكامل

انظر لهذه المحاولة عسى انها تقرب المسافات لما تريد

 

AAA.accdb

[Moosak]

وهذه تجربتي مع أخي المهندس قاسم @Eng.Qassim ومستندا على ملفه 🙂 

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

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

وهذه هي الدالة :

Public Function LoopThroughText(TXT As String) As String
Dim LookInHere As String
Dim Counter As Integer
Dim SplitCatcher As Variant
Dim Finaltxt As String
 
LookInHere = TXT
SplitCatcher = Split(LookInHere, " ")
 
For Counter = 0 To UBound(SplitCatcher)
    
    If SplitCatcher(Counter) = DLookup("[PerName]", "[NamesT]", "[PerName] Like '*" & SplitCatcher(Counter) & "*'") Then
        If DLookup("[Type]", "[NamesT]", "[PerName] Like '*" & SplitCatcher(Counter) & "*'") = 1 Then
            Finaltxt = Finaltxt & " " & SplitCatcher(Counter)
        Else
            Finaltxt = Finaltxt & " " & SplitCatcher(Counter) & "،"
        End If
    End If
Next
 LoopThroughText = Finaltxt
End Function

بعدها تنادي على الدالة في استعلام أو نموذج كما تشاء هكذا :

LoopThroughText(TXT)

 

AAA.accdb

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

[Eng.Qassim]

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

وهذه تجربتي

ياسلام على الابداع استاذ موسى ...كلك ذوق يافنان

 

[قاسم اللبناني]

الرد قيد التجربة 

الله يحفظك ويوفقك اخي ونشكر تواضعك  

[قاسم اللبناني]

نعم هذا المطلوب ربي يحفظك 

وياااريت على طريقه تخلي كل اسم لحالة  في صف مستقل

[Moosak]

28 دقائق مضت, قاسم اللبناني said:

نعم هذا المطلوب ربي يحفظك 

وياااريت على طريقه تخلي كل اسم لحالة  في صف مستقل

ربي يبارك فيك دكتور قاسم ..

في هذه الجزئية من الكود غير هذا :

في 5‏/5‏/2022 at 21:00, Moosak said:

Finaltxt = Finaltxt & " " & SplitCatcher(Counter) & "،"

إلى :

Finaltxt = Finaltxt & " " & SplitCatcher(Counter) & vbNewLine

 

[قاسم اللبناني]

ربي يحفظك استاذي الفاضل