استعلام تغيير و تحديث من خلال جدول

[محمد احمد لطفى]

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

أريد عمل استعلام تغيير و تحديث 

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

فهل يمكن عمل هذه الاحداث عن طريق جدول 

وجزاكم الله خيراً 

 

Replace&add.mdb

[Eng.Qassim]

وعليكم السلام استاذ محمد..

في رأيي..افضل طريقة بوضع شارطة قبل التسمية التي تريد كمثال ..محمد احمد/ مقاولات ...محمد احمد/ مقاولات عامة

ثم تستخدم الموديول التالي ..وتستدعيه من الاستعلام ..

Public Function splitword(myNamX As String) As String
Dim exampleString As String
Dim exampleArray() As String

exampleString = myNamX
exampleArray = Split(exampleString, "/")
splitword = exampleArray(1)
End Function

 

[محمد احمد لطفى]

أستاذى @Eng.Qassim

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

فالمطلوب نقل النشاط كـ المقاولات أو مخبز أو استيراد من خانة Namex الى KindX وسوف اكتب فى   KindX ما يتم نقله مثلا سوف انقل المقاولا و لكن فى kindx سوف ينقل مقاولات عامة و الفكرة انه هناك انشطة مكتوبة خطأ سوف أصححها 

[Eng.Qassim]

منذ ساعه, محمد احمد لطفى said:

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

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

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

 

 

 

تم تعديل أبريل 5, 2023 بواسطه Eng.Qassim

[محمد احمد لطفى]

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

[kanory]

مشاركة مع استاذي المهندس @Eng.Qassim

هل تريدها بهذه الصورة في استعلام ........

[محمد احمد لطفى]

أستاذى @kanory

بهذه الطريقة لو أن النشاط غير موجود مثلا سينقل الاسم الاخير للشخص

 

[kanory]

7 دقائق مضت, محمد احمد لطفى said:

أستاذى @kanory

بهذه الطريقة لو أن النشاط غير موجود مثلا سينقل الاسم الاخير للشخص

 

طيب انظر هذا ..................

 

[kanory]

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

 

[Eng.Qassim]

1 ساعه مضت, kanory said:

طيب انظر هذا

هذه ممتازة لانه لم يأخذ الاسم الاخير حينما لايكون هناك نشاط

[محمد احمد لطفى]

تمام أستاذى @kanory

وهل يمكن مسحها من الخلية الاولى

[kanory]

10 ساعات مضت, محمد احمد لطفى said:

تمام أستاذى @kanory

وهل يمكن مسحها من الخلية الاولى

طيب اخي الكريم انظر الصور ::::::::::::::::

واحدة قبل التحديث في الجدول والثانية بعد تحديث الجدول ومع وجود اسم صالح احمد بدون وظيفة .......

 

Replace&add.mdb

[محمد احمد لطفى]

أستاذى @kanory

حميل جدا أستاذى و لكن هكذا ان كان النشاط كلمة واحدة

هل يمكن التعديل يعمل كلمة و اثنين او ثلاثة 

[kanory]

2 ساعات مضت, محمد احمد لطفى said:

أستاذى @kanory

حميل جدا أستاذى و لكن هكذا ان كان النشاط كلمة واحدة

هل يمكن التعديل يعمل كلمة و اثنين او ثلاثة 

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

[kanory]

ممكن تضيف لنا عينات لانشطة متعددة الكلمات

[محمد احمد لطفى]

أسف على الازعاج 

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

[ابوبسمله]

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

مشاركه مع اخوتى واساتذتى الافاضل @Eng.Qassim و @kanory جزاهم الله عنا كل خير 💐

اتفضل استاذ @محمد احمد لطفى

افتح الجدول TableX ستجده كالتالى ثم اغلقه

TableX

NameX	KindX	DateX
محمد احمد مقاولات		01/03/2023
خالد استيراد		01/03/2023
احمد مخبز		01/03/2023
سمير مقاولات متكاملة استيراد و تصدير

ثم اضغط على الزر فالنموذج ثم اغلق النموذج وافتح الجدول ستجده

TableX

NameX	KindX	DateX
محمد احمد	مقاولات عامة	01/03/2023
خالد	استيراد وتصدير	01/03/2023
احمد	مخبز	01/03/2023
سمير	مقاولات عامة

وهذا هو الكود

Sub ReplaceName()
    Dim rs As Recordset
    Dim rs2 As Recordset
    
    Set rs = CurrentDb.OpenRecordset("KindX")
    Set rs2 = CurrentDb.OpenRecordset("TableX", dbOpenDynaset)
    
    Dim dic As Scripting.Dictionary
    Set dic = New Scripting.Dictionary
    
    On Error Resume Next
    
    rs.MoveLast: rs.MoveFirst
      
    For i = 0 To rs.RecordCount - 1
        dic.Add rs("LikeB").Value, rs("LikeA").Value
        rs.MoveNext
    Next
    
    For Each Key In dic.Keys
'        Debug.Print "Key: " & Key & " Value: " & dic(Key)

        rs2.FindFirst "[NameX] Like '*" & dic(Key) & "*' "

        Do While Not rs2.EOF
'            Debug.Print rs2![NameX]
                If InStr(rs2("NameX"), dic(Key)) Then
                    rs2.Edit
                    rs2("KindX") = Key
                    rs2("NameX") = Left(rs2![NameX], InStr(rs2![NameX], dic(Key)) - 1)
                    rs2.Update
                End If
            rs2.MoveNext
        Loop
    Next
    
    rs.Close
    rs2.Close
    Set rs = Nothing
    Set rs2 = Nothing
    Set dic = Nothing
    
End Sub

بالتوفيق

Replace&add_A.mdb

تم تعديل أبريل 7, 2023 بواسطه ابوبسمله

[محمد احمد لطفى]

جزاك الله خيرا أستاذى @ابوبسمله

ربنا يفتحها عليك

هناك بعض الملاحظات 
 1 - سمير مقاولات متكاملة استيراد و تصدير              تم نقل مقاولات عامة

و عند تغيير مقاولات متكاملة استيراد و تصدير            النتيجة  مقاولات متكاملة استيراد و تصدير            لا ينقلها و ينقل مقاولات عامة اى ينقل مايساوى مقاولات

 

[kanory]

19 ساعات مضت, محمد احمد لطفى said:

أسف على الازعاج 

ليس هناك ازعاج اخي الكريم ولكن القصد حتى نصل لما تريد لاقصر الطرق .... بارك الله فيك

19 ساعات مضت, محمد احمد لطفى said:

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

وهذه طريقة اخرى جربها واعلمنا بالنتيجة 

Function FnSearch(Str As String) As String
Dim Arr() As String
Dim i As Long
Arr = Split(Str)
  '    """" & txtSearch & """"
  For i = 0 To UBound(Arr) - 1
    If Nz(DLookup("LikeA", "KindX", "LikeA='" & Trim(Arr(i)) & "'"), 0) <> 0 Then
      FnSearch = DLookup("LikeB", "KindX", "LikeA='" & Trim(Arr(i)) & "'")
      Exit For
    ElseIf Nz(DLookup("LikeA", "KindX", "LikeA='" & Trim(Arr(i)) & " " & Trim(Arr(i + 1)) & "'"), 0) <> 0 Then
      FnSearch = DLookup("LikeB", "KindX", "LikeA='" & Trim(Arr(i)) & " " & Trim(Arr(i + 1)) & "'")
      Exit For
    End If
  Next i
End Function

 

Replace&add.mdb

[ابوبسمله]

اتفضل اخى @محمد احمد لطفى

التعديل

TableX

NameX	KindX	DateX
محمد احمد	مقاولات عامة	01/03/2023
خالد	استيراد وتصدير	01/03/2023
احمد	مخبز	01/03/2023
سمير	مقاولات متكاملة استيراد و تصدير

تسلم ايدك اخى @kanory 🌹

تقبلوا تحياتى ومرورى

Replace&add_B.mdb

[محمد احمد لطفى]

أستاذى @kanory

عند كتابة مقاولات متكاملة و استيراد وتصدير       = مقاولات متكاملة و استيراد وتصدير                        ينقل استيراد تصدير 

أستاذى @ابوبسمله  

بسم الله ماشاء الله  ينقل ما يساويه بالتمام

وهناك ملاحظات أرجو أن تتقبلها 

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

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

تقبل الله منا ومنكم صالح الأعمال  

[محمد احمد لطفى]

أستاذى @ابوبسمله

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

وجزاك الله كله خيراً

Replace&add_B (1).mdb

[kanory]

في 8‏/4‏/2023 at 12:57, محمد احمد لطفى said:

أستاذى @kanory

عند كتابة مقاولات متكاملة و استيراد وتصدير       = مقاولات متكاملة و استيراد وتصدير                        ينقل استيراد تصدير 
 

طيب الكود التالي يقوم بالاتي ::::::::

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

- حذف تلك العبارة من الجدول نهائيا ......

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

 

Replace&add.mdb

[محمد احمد لطفى]

شكراً أستاذى @kanory

ربنا يبارك فيك و يحفظك 

[kanory]

23 دقائق مضت, محمد احمد لطفى said:

شكراً أستاذى @kanory

ربنا يبارك فيك و يحفظك 

هل تم حل المشكلة لديك ؟؟