دالة لربط حقل رقمي في جدول برقم اخر موجود بين رقمين في جدول اخر

[محمد القدسي]

السلام عليكم 

اساتذتي الافاضل مطلوب دالة لتحديث حقل firstnosanad الموجود في جدول tableestelame 

بحقل firstnosanad موجود في جدول tablesnadat وذلك عند تسجيل اي رقم في حقل taslsolnosanad الموجود في جدول tableestelame 

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

بمعنى اريد بديل للدالة DFirst تحقق المطلوب 

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

وبارك الله في الجميع

exambledata.rar

[محمد القدسي]

up

[محمد القدسي]

up

up

[أبوبسمله]

السلام عليكم اخى @محمد القدسي

على ما فهمت من سؤالك واعذرنى لقله فهمى

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

تم انشاء وحده نمطيه

Function strFind(txtFind As Integer)
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim strSQL As String

strSQL = "SELECT tablesnadat.firstnosanad " & _
         "FROM tablesnadat " & _
         "WHERE tablesnadat.firstnosanad <=" & txtFind & " And tablesnadat.endnosanad >= " & txtFind
         
Set db = CurrentDb
Set rs = db.OpenRecordset(strSQL)

    Do Until rs.EOF
        strFind = rs.Fields(0)
      ' Debug.Print rs.Fields(0)
        rs.MoveNext
    Loop

rs.Close
Set rs = Nothing
Set db = Nothing
End Function

وتم استدعائها بالاستعلام كالتالى

 strFind([firstnosanad])

وتم استدعائها فالنموذج للحقل الملون بالاحمر Exfirstnosanad بنفس الطريقه

=strFind([taslsolnosanad])

بالتوفيق اخى

exambledata.accdb

تم تعديل يناير 30, 2021 بواسطه احمد الفلاحجي

[محمد القدسي]

اشكرك استاذي @احمد الفلاحجي على هذه الاجابة 

وهو المطلوب الذي اريده فجزاك الله خيرا وبارك فيك

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

بحيث يظهر لي اسم المندوب مثل هذه 

strFind([firstnosanad])

واعذرني ان اثقلت عليك اخي

[أبوبسمله]

21 ساعات مضت, محمد القدسي said:

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

الشكر لله ثم لاخواننا واساتذتنا جزاهم الله عنا كل خير

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

ومفيش ثقل ولا حاجه انا بتعلم معاكم واكتسب كل يوم معلومات من اسئلتكم ومشاركتكم

بالتوفيق اخى

[محمد القدسي]

استاذي العزيز 

المرفق عبارة عن مثال

وما اريده ان في الشركة مندوبين لاستلام وتسليم شحنات بريد من والى المحافظات 

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

وعليه يتم احتساب عمولات للمندوبين 

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

ارجو انني وفقت في الشرح لما اريد

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

[أبوبسمله]

19 دقائق مضت, محمد القدسي said:

في الشركة مندوبين لاستلام وتسليم شحنات بريد من والى المحافظات 

تبع البريد المصرى ولا شركه خاصه  ؟

لا تكون تبعنا بوسطجى زيي ههههههههههه

انا من رايى بان يوجد جدول خاص بالمناديب ببياناته

وجدول خاص بارقام الدفاتر وممكن تكتفى في جدول الدفاتر ببدايه الرقم وفى النماذج تعمل شروط اذا كان الدفتر 50 ايصال مثلا

وهتضيف حقل رقم المندوب فى جدول الدفاتر للربط مع جدول الدفاتر وحقل تاريخ لاثبات تاريخ استلامه للدفتر

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

[محمد القدسي]

تسلم استاذي على التنبه 

وننتظر استاذتنا بالمشاركة

[محمد القدسي]

up

[أبوبسمله]

11 ساعات مضت, محمد القدسي said:

up

قم بازاله أفضل اجابه طالما تنتظر اجابه أخرى لأن معظم الاخوه والأساتذة لا ينظرون إلى المواضيع المجابه

[محمد القدسي]

وكيف السبيل لازالة افضل اجابة استاذي العزيز

[أبوبسمله]

8 ساعات مضت, محمد القدسي said:

وكيف السبيل لازالة افضل اجابة استاذي العزيز

اذهب الى المشاركه المعلمه كافضل اجابه

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

بالتوفيق

[محمد القدسي]

اشكرك استاذي 

تم الغاء افضل اجابة ومنتظر مشاركة اساتذتنا في الموضوع

[محمد القدسي]

up

[أبوبسمله]

السلام عليكم اخى @محمد القدسي

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

Function strFind()
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim rs1 As DAO.Recordset
Dim strSQL As String
Dim strSQL1 As String

strSQL = "SELECT tablesnadat.firstnosanad ,tablesnadat.namemandop,tablesnadat.endnosanad " & _
         "FROM tablesnadat "
         
Set db = CurrentDb
Set rs = db.OpenRecordset(strSQL)
Set rs1 = db.OpenRecordset("tableestelame")

For i = 0 To rs1.RecordCount - 1
    rs.MoveLast: rs.MoveFirst
    For ii = 0 To rs.RecordCount - 1
        If rs1.Fields(2) >= rs.Fields(0) And rs1.Fields(2) <= rs.Fields(2) Then
            rs1.Edit
            rs1.Fields(3) = rs.Fields(0)
            rs1.Fields(1) = rs.Fields(1)
            rs1.Update
        End If
    
    rs.MoveNext
    Next
rs1.MoveNext
Next

rs.Close
Set rs = Nothing
Set db = Nothing
End Function

 

exambledata-1.accdb

[محمد القدسي]

اشكرك استاذي على تجاوبك 

لك مني ولجميع من تعاون معنا في هذا الصرح العلمي المبارك 

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

[أبوبسمله]

الشكر لله ثم لاخواننا واساتذتنا جزاهم الله خيرا

بالتوفيق اخى محمد

[محمد القدسي]

اشكرك استاذي 

ولاكن كيف يتم تطبيق الدالة في الاستعلام كما تفضلت به في المثال السابق

[أبوبسمله]

23 ساعات مضت, محمد القدسي said:

ولاكن كيف يتم تطبيق الدالة في الاستعلام كما تفضلت به في المثال السابق

الشكر لله ثم لاخواننا واساتذتنا جزاهم الله خيرا

اتفضل

Function strFind(txtFind As Integer)
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim rs1 As DAO.Recordset
Dim strSQL As String
Dim strSQL1 As String
On Error Resume Next
strSQL = "SELECT tablesnadat.firstnosanad ,tablesnadat.namemandop,tablesnadat.endnosanad " & _
         "FROM tablesnadat " & _
         "WHERE tablesnadat.firstnosanad <=" & txtFind & " And tablesnadat.endnosanad >= " & txtFind
         
         
Set db = CurrentDb
Set rs = db.OpenRecordset(strSQL)
Set rs1 = db.OpenRecordset("tableestelame")

For i = 0 To rs1.RecordCount - 1
     rs.MoveLast: rs.MoveFirst
    For ii = 0 To rs.RecordCount - 1
        If rs1.Fields(2) >= rs.Fields(0) And rs1.Fields(2) <= rs.Fields(2) Then
            rs1.Edit
            rs1.Fields(3) = rs.Fields(0)
            rs1.Fields(1) = rs.Fields(1)
            rs1.Update
        End If
    
    rs.MoveNext
    Next
rs1.MoveNext
Next

rs.Close
Set rs = Nothing
Set db = Nothing
End Function

 

exambledataNew - 2.accdb

[محمد القدسي]

استاذي العزيز @احمد الفلاحجي 

تم تطبيق مثالك ما تكرمت به علينا على برنامجي 

وما شاء الله الامور طيبة 

فجزاك الله خيرا وبارك فيك وفي علمك واهلك ومالك واولادك

انت وكل من يعاون مع اخوانه في هذا المنتدى الطيب

[أبوبسمله]

الحمدلله الذى بنعمته تتم الصالحات

واياكم اخى

بالتوفيق