استخراج او جلب قيمة موجودة في جملة نصية

[محمد عبد الله ٢]

السلام عليكم و رحمة الله و بركاته
حياكم الله اخواني الكرام
في النموذج المرفق جدولين
Test 2 يحتوي على معلومات بشكل رسالة 
المطلوب عند الضغط على زر تفريغ في النموذج 2 ان يتم تحويل القيم المالية الى الجدول الاول بشكل منفصل

و التفاصيل في النموذج
و لكم جزيل الشكر

MMD12.accdb

[Barna]

في 4‏/9‏/2024 at 23:28, محمد عبد الله ٢ said:

السلام عليكم و رحمة الله و بركاته
حياكم الله اخواني الكرام
في النموذج المرفق جدولين
Test 2 يحتوي على معلومات بشكل رسالة 
المطلوب عند الضغط على زر تفريغ في النموذج 2 ان يتم تحويل القيم المالية الى الجدول الاول بشكل منفصل

و التفاصيل في النموذج
و لكم جزيل الشكر

يعني تريد نقل هذه البيانات مجزئة للحقول الظاهرة في النموذج الاخر ... صحيح هذه المطلوب ؟؟ 
 

[محمد عبد الله ٢]

Barna حياك الله استاذي المحترم

نعم هذا المطلوب 

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

[Barna]

18 دقائق مضت, محمد عبد الله ٢ said:

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

طيب ... بارك الله فيك ...

هل دائما تنسيق الرسالة بالطريقة الموجودة في المرفق

[محمد عبد الله ٢]

صراحة لا

قد تكون الفراغات بين الاسطر غير متناسقة في بعض الاحيان

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

منذ ساعه, Barna said:

طيب ... بارك الله فيك ...

هل دائما تنسيق الرسالة بالطريقة الموجودة في المرفق

و لكن التسميات المالية موحدة بدون تغيير

[Barna]

7 دقائق مضت, محمد عبد الله ٢ said:

و لكن التسميات المالية موحدة بدون تغيير

اقصد هذه المسميات والعلامات ...

 

[محمد عبد الله ٢]

منذ ساعه, Barna said:

اقصد هذه المسميات والعلامات ...

 

نعم هذه التسميات و العلامات ثابتة لا تتغير , لكن من الممكن ان تختلف بحيث ان تكون متلاصقة او تم ضغط space لترك فراغ مثال / 37   $ عمال/ او/ 37$عمال/

تم تعديل سبتمبر 9 بواسطه محمد عبد الله ٢

[Barna]

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

    Dim strField As String
    Dim regex As Object
    Dim matches As Object
    Dim match As Variant
    Dim cleanedValue As String
    Dim FullText As String
    Dim FirstPhrase, SecondPhrase As String
    Dim RemainingText As String
    Set regex = CreateObject("VBScript.RegExp")
    
    regex.Global = True
    regex.IgnoreCase = True
    
            strField = Me.a
            regex.Pattern = "الوزن:\d+|\d+\s*\$\s*اجار شاحنة|\d+\s*\$\s*عمال|\d+\s*\$\s*رسوم|\d+\s*\$\s*وصل|\d+\s*\$\s*خدمات|العدد:\d+"
            Set matches = regex.Execute(strField)

            FirstPhrase = Split(strField, "المادة")(0)
            SecondPhrase = Split(strField, "العدد")(0)
            RemainingText = Replace(SecondPhrase, FirstPhrase & "المادة", "")
            FirstPhrase = Replace(FirstPhrase, "السيد", "")
            DoCmd.OpenForm "Test1", , , , acFormAdd
            Forms!Test1.Form.Recordset.AddNew
For Each match In matches
        cleanedValue = Replace(match.Value, "$", "")
        cleanedValue = Replace(cleanedValue, "الوزن:", "")
        cleanedValue = Replace(cleanedValue, "رسوم", "")
        cleanedValue = Replace(cleanedValue, "وصل", "")
        cleanedValue = Replace(cleanedValue, "خدمات", "")
        cleanedValue = Replace(cleanedValue, "عمال", "")
        cleanedValue = Replace(cleanedValue, "اجار شاحنة", "")
        cleanedValue = Replace(cleanedValue, "العدد:", "")
        cleanedValue = Trim(cleanedValue)
        
        If InStr(match.Value, "الوزن:") > 0 Then
        Forms![Test1]![d].Value = cleanedValue
        ElseIf InStr(match.Value, "عمال") > 0 Then
        Forms![Test1]![g].Value = cleanedValue
        ElseIf InStr(match.Value, "وصل") > 0 Then
        Forms![Test1]![e].Value = cleanedValue
        ElseIf InStr(match.Value, "خدمات") > 0 Then
        Forms![Test1]![f].Value = cleanedValue
        ElseIf InStr(match.Value, "اجار شاحنة") > 0 Then
        Forms![Test1]![h].Value = cleanedValue
        ElseIf InStr(match.Value, "العدد:") > 0 Then
        Forms![Test1]![c].Value = cleanedValue
        End If
Next match
        Forms![Test1]![a].Value = FirstPhrase
        Forms![Test1]![b].Value = RemainingText

 

[محمد عبد الله ٢]

منذ ساعه, Barna said:

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

    Dim strField As String
    Dim regex As Object
    Dim matches As Object
    Dim match As Variant
    Dim cleanedValue As String
    Dim FullText As String
    Dim FirstPhrase, SecondPhrase As String
    Dim RemainingText As String
    Set regex = CreateObject("VBScript.RegExp")
    
    regex.Global = True
    regex.IgnoreCase = True
    
            strField = Me.a
            regex.Pattern = "الوزن:\d+|\d+\s*\$\s*اجار شاحنة|\d+\s*\$\s*عمال|\d+\s*\$\s*رسوم|\d+\s*\$\s*وصل|\d+\s*\$\s*خدمات|العدد:\d+"
            Set matches = regex.Execute(strField)

            FirstPhrase = Split(strField, "المادة")(0)
            SecondPhrase = Split(strField, "العدد")(0)
            RemainingText = Replace(SecondPhrase, FirstPhrase & "المادة", "")
            FirstPhrase = Replace(FirstPhrase, "السيد", "")
            DoCmd.OpenForm "Test1", , , , acFormAdd
            Forms!Test1.Form.Recordset.AddNew
For Each match In matches
        cleanedValue = Replace(match.Value, "$", "")
        cleanedValue = Replace(cleanedValue, "الوزن:", "")
        cleanedValue = Replace(cleanedValue, "رسوم", "")
        cleanedValue = Replace(cleanedValue, "وصل", "")
        cleanedValue = Replace(cleanedValue, "خدمات", "")
        cleanedValue = Replace(cleanedValue, "عمال", "")
        cleanedValue = Replace(cleanedValue, "اجار شاحنة", "")
        cleanedValue = Replace(cleanedValue, "العدد:", "")
        cleanedValue = Trim(cleanedValue)
        
        If InStr(match.Value, "الوزن:") > 0 Then
        Forms![Test1]![d].Value = cleanedValue
        ElseIf InStr(match.Value, "عمال") > 0 Then
        Forms![Test1]![g].Value = cleanedValue
        ElseIf InStr(match.Value, "وصل") > 0 Then
        Forms![Test1]![e].Value = cleanedValue
        ElseIf InStr(match.Value, "خدمات") > 0 Then
        Forms![Test1]![f].Value = cleanedValue
        ElseIf InStr(match.Value, "اجار شاحنة") > 0 Then
        Forms![Test1]![h].Value = cleanedValue
        ElseIf InStr(match.Value, "العدد:") > 0 Then
        Forms![Test1]![c].Value = cleanedValue
        End If
Next match
        Forms![Test1]![a].Value = FirstPhrase
        Forms![Test1]![b].Value = RemainingText

 

جزاك الله خيرا استاذي الكريم

الكود يعمل بشكل صحيح 

لك مني كل الاحترام و التقدير

[Barna]

1 دقيقه مضت, محمد عبد الله ٢ said:

الكود يعمل بشكل صحيح 

لك مني كل الاحترام و التقدير

طيب ... الحمدلله رب العالمين

[ابوخليل]

تم تعديل العنوان بما يناسب الموضوع