اذهب الي المحتوي
أوفيسنا

الردود الموصى بها

قام بنشر

السلام عليكم

ارجوا مساعدتى فى عمل استعلام معين . فانا عندى جدولين الاول يحوى على حقل يتم فيه تعبته بعدد المجموعات المطلوبة مثل عدد المجموعات المطلوبة = 5 او 6 او 10 وهكذا وهذا الجدول الاول هو كما يلى

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

عدد المجموعات =

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

اما الجدول الثانى فيحوى على اسماء مجموعة من الاعضاء ولكل عضو رقم عضوية . اذا هذا الجدول يحوى على حقل لعضوية العضو واحقل اخر لاسمه

كما يلى

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

رقم العضوية الاسم

1 محمد

2 سعيد

3 سالم

4 احمد

5 سليمان

6 طاهر

7 عقيل

8 عمر

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

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

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

رقم العضوية الاسم المجموعات الدور

1 محمد 1 1

2 سعيد 2 1

3 سالم 1 2

4 احمد 2 2

5 سليمان 1 3

6 طاهر 2 3

7 عقيل 1 4

8 عمر 2 4

اما اذا كا ن عدد المجمةعات =3 فيكون نتيجة الاستعلام كتالي:

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

رقم العضوية الاسم المجموعات الدور

1 محمد 1 1

2 سعيد 2 1

3 سالم 3 1

4 احمد 1 2

5 سليمان 2 2

6 طاهر 3 2

7 عقيل 1 3

8 عمر 2 3

اما اذا كا ن عدد المجمةعات =4 فيكون نتيجة الاستعلام كتالي:

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

رقم العضوية الاسم المجموعات الدور

1 محمد 1 1

2 سعيد 2 1

3 سالم 3 1

4 احمد 4 1

5 سليمان 1 2

6 طاهر 2 2

7 عقيل 3 2

8 عمر 4 2

وهكذا...................

فالرجاء مساعدتي فى كيفية عمل هذا ا الاستعلام

و السلام عليكم

  • Thanks 1
قام بنشر

المثال

http://www.pcpages.com/osama457/SerialInGroub2.zip

فيه استعلامين

Simple_Q

هذا بدون كود لكن لازم تكون الارقام المسجلة متسلسلة يعني بدون ارقام مفقودة ، ولازم تكون السجلات مفروزة حسب الرقم

Code_Q

بالكود ، ويمشي حتى لو كانت الارقم المسجلة ملخبطة وناقصة .

SerialInGroub2.zip

  • Thanks 1
قام بنشر

الكود لعموم الفايدة

Option Compare Database

Option Explicit

Dim GroubsCount As Integer


Function GroubNumber(ByVal InNumber As Integer) As Integer

GroubsCount = DFirst("[b_Groubs]", "[b_tbl]")

If GroubsCount = 0 Then Exit Function

InNumber = TrueSerial(InNumber)

If InNumber Mod GroubsCount = 0 Then

GroubNumber = GroubsCount

Else

GroubNumber = InNumber Mod GroubsCount

End If

End Function


Function SerialNumber(ByVal InNumber As Integer) As Integer

GroubsCount = DFirst("[b_Groubs]", "[b_tbl]")

If GroubsCount = 0 Then Exit Function

InNumber = TrueSerial(InNumber)

If InNumber Mod GroubsCount = 0 Then

SerialNumber = (InNumber - (InNumber Mod GroubsCount)) / GroubsCount

Else

SerialNumber = (InNumber - (InNumber Mod GroubsCount)) / GroubsCount + 1

End If

End Function


Private Function TrueSerial(ByVal InNumber As Integer) As Integer

Dim dbs As Database

Dim rst As Recordset

Dim I As Integer

Set dbs = Application.CurrentDb

Set rst = dbs.OpenRecordset("Code_Q", dbOpenSnapshot)

If rst.RecordCount <> 0 Then

    rst.MoveFirst

    Do Until rst.EOF

        I = I + 1

        If InNumber = rst!a_Number Then

            InNumber = I

            Exit Do

        End If

        rst.MoveNext

    Loop

End If

rst.Close

Set rst = Nothing

Set dbs = Nothing

TrueSerial = InNumber

End Function

قام بنشر

الاخ خبير الاكسس Osama456

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

جزاك الله خير الجزاء على جهدك الرائع جدا .

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

بهذه الخبرات تعلوا الامم

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information