ترقيم حقل بناء على قيمة حقل آخر

[nssj]

الإخوة الكرام .. في الملف المرفق المطلوب ترقيم حقل (MNO) بناء على قيمة الحقل (TYPE1) وذلك على أساس:

السجلات التي تكون فيها قيمة الحقل (TYPE1) = 1  ، يتم ترقيمها ترقيما متسلسلا من (1) إلى (10000)

وما سوى ذلك يبدأ ترقيمها من (10001)

Musnd.accdb

[ابوخليل]

تفضل

ضعه في حدث النقر على الزر

On Error Resume Next
Dim i As Integer
Dim ii As Long
Dim rs1, rs2 As dao.Recordset
Set rs1 = CurrentDb.OpenRecordset("SELECT * FROM TAB WHERE TAB.TYPE1=1")
Set rs2 = CurrentDb.OpenRecordset("SELECT * FROM TAB WHERE TAB.TYPE1>1")
rs1.MoveLast: rs1.MoveFirst
For i = 0 To 10000 Step 0
i = i + 1
rs1.Edit
rs1!MNO = i
rs1.Update
rs1.MoveNext
Next i
rs2.MoveLast: rs2.MoveFirst
ii = 10000
For ii = 10000 To 100000 Step 0
ii = ii + 1
rs2.Edit
rs2!MNO = ii
rs2.Update
rs2.MoveNext
Next ii
 Set rs1 = Nothing
 Set rs2 = Nothing

 

[nssj]

جزاك الله خيرا أخي الكريم ابوخليل

ولكن بحاجة لتعديل بسيط، وهو أن يكون الترقيم متسلسلا حسب ترتيب السجلات المعتمد على حقل (TNO)

فبالنظر للملف المرفق تلاحظ أن الكود بدأ برقم (10001) في السجل رقم (31) بينما السجل رقم (2) وما بعده أعطاه الرقم (10207)

ومقتضى الترتيب أن يبدأ الترقيم من السجل (2) وهكذا

هذا ما لاحظته ولم أتتبع الترقيم في بقية السجلات .. فهل من طريقة للتأكد من تسلسل الترقيم في النوعين حسب ترتيب (TNO)

أرجو أن أكون وفقت في الشرح

وطلب آخر إن تكرمت .. هل لك أن تبين لي ما ذا ينبغي أن أغير في الكود إذا أردت أن يبدأ الترقيم الثاني من (20001) مثلاً .. لأن تحديد بداية الترقيم الثاني يعتمد على عدد السجلات في الملف النهائي الذي لا زال طور الإعداد

Musnd02.accdb

[biskra]

منذ ساعه, nssj said:

وطلب آخر إن تكرمت .. هل لك أن تبين لي ما ذا ينبغي أن أغير في الكود إذا أردت أن يبدأ الترقيم الثاني من (20001) مثلاً .. لأن تحديد بداية الترقيم الثاني يعتمد على عدد السجلات في الملف النهائي الذي لا زال طور الإعداد

في هذه الجزئية عوض الأرقام في الكود 10000 بـ 20000 فقط،

 

[ابوخليل]

وهذا للجزء الأول من السؤال

استبدل السطرين في الكود السابق بهذين

Set rs1 = CurrentDb.OpenRecordset("SELECT TAB.MNO, TAB.TNO FROM TAB WHERE TAB.TYPE1 =1 ORDER BY TAB.TNO")
Set rs2 = CurrentDb.OpenRecordset("SELECT TAB.MNO, TAB.TNO FROM TAB WHERE TAB.TYPE1 >1 ORDER BY TAB.TNO")

 

[nssj]

27 دقائق مضت, biskra said:

في هذه الجزئية عوض الأرقام في الكود 10000 بـ 20000 فقط،

شكرا لك أخي الكريم ..

والرقم الثاني الذي بعده 

100000

هل يعني أن الكود يرقم السجلات بهذا العدد فقط، وإذا كان الملف أكبر من ذلك ينبغي تغييره إلى (200000) أو أكثر

[biskra]

الأستاذ أبو خليل ملاحظة بسيطة على الكود، يحتمل أن أكون مخطئ فيها

قمت بتجربته، و وجدت أن عدد السجلات من نوع (TYPE1) = 1 أي التي تخضع للإجراء الأول من الكود عددها 741 سجل،

 فعوضت رقم 10000 بـ 741 و نفذت الكود، فلاحظت أن الشرط الثاني من الكود بدأ أول سجل فيها من رقم 742 عوض أن تبدأ من 741 قياسا على بداية العدد بـ 10001 لما كان المعيار 10000، أظن أن المجال يجب أن يكون 9999 في هذه الجزئية.

مجرد رأي على كل حال،

 

For i = 0 To 9999 Step 0

[biskra]

10 دقائق مضت, nssj said:

هل يعني أن الكود يرقم السجلات بهذا العدد فقط، وإذا كان الملف أكبر من ذلك ينبغي تغييره إلى (200000) أو أكثر

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

[ابوخليل]

8 دقائق مضت, biskra said:

الأستاذ أبو خليل ملاحظة بسيطة على الكود، يحتمل أن أكون مخطئ فيها

قمت بتجربته، و وجدت أن عدد السجلات من نوع (TYPE1) = 1 أي التي تخضع للإجراء الأول من الكود عددها 741 سجل،

 فعوضت رقم 10000 بـ 741 و نفذت الكود، فلاحظت أن الشرط الثاني من الكود بدأ أول سجل فيها من رقم 742 عوض أن تبدأ من 741 قياسا على بداية العدد بـ 10001 لما كان المعيار 10000، أظن أن المجال يجب أن يكون 9999 في هذه الجزئية.

مجرد رأي على كل حال،

 

For i = 0 To 9999 Step 0

المقطع الثاني يبدأ بـــ  10001 حسب طلبه

فبتعديلك هنا سوف يبدأ العدد بـــ 10000

امهلني سوف اعالج المسألة بطريقة أخرى

[ابوخليل]

هكذا افضل

On Error Resume Next
Dim i As Integer
Dim ii As Long
Dim rs1, rs2 As Dao.Recordset
Set rs1 = CurrentDb.OpenRecordset("SELECT TAB.MNO, TAB.TNO FROM TAB WHERE TAB.TYPE1 =1 ORDER BY TAB.TNO")
Set rs2 = CurrentDb.OpenRecordset("SELECT TAB.MNO, TAB.TNO FROM TAB WHERE TAB.TYPE1 >1 ORDER BY TAB.TNO")
rs1.MoveLast: rs1.MoveFirst
For i = 0 To rs1.RecordCount Step 0
i = i + 1
rs1.Edit
rs1!MNO = i
rs1.Update
rs1.MoveNext
Next i
rs2.MoveLast: rs2.MoveFirst
ii = 10000
For ii = 1 To rs2.RecordCount Step 0
ii = ii + 1
rs2.Edit
rs2!MNO = ii
rs2.Update
rs2.MoveNext
Next ii
 Set rs1 = Nothing
 Set rs2 = Nothing

 

[biskra]

2 دقائق مضت, ابوخليل said:

هكذا افضل

هكذا سوف يسهل على الأخ NSSJ التعديل عليه حسب رغبته بتعديل رقم واحد فقط حسب رغبته.

[nssj]

أخي الكريم ابوخليل

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

وعندما عدت إلى الكود الأول باستبدال السطرين المذكورين كانت النتيجة تمام

إذا كان جعل الترقيم الثاني يبدأ بـ (10000) أو ما يشبهه (20000 - 30000) يحل المشكلة فالأمر هين

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

[ابوخليل]

تعديل بسيط  ان شاء الله يكون هو  المتقن والمعتمد

On Error Resume Next
Dim i As Integer
Dim ii, j As Long
Dim rs1, rs2 As Dao.Recordset
Set rs1 = CurrentDb.OpenRecordset("SELECT TAB.MNO, TAB.TNO FROM TAB WHERE TAB.TYPE1 =1 ORDER BY TAB.TNO")
Set rs2 = CurrentDb.OpenRecordset("SELECT TAB.MNO, TAB.TNO FROM TAB WHERE TAB.TYPE1 >1 ORDER BY TAB.TNO")
rs1.MoveLast: rs1.MoveFirst
For i = 0 To rs1.RecordCount Step 0
i = i + 1
rs1.Edit
rs1!MNO = i
rs1.Update
rs1.MoveNext
Next i
rs2.MoveLast: rs2.MoveFirst
ii = 10000
For ii = 10000 To (rs2.RecordCount + ii) Step 0
ii = ii + 1
rs2.Edit
rs2!MNO = ii
rs2.Update
rs2.MoveNext
Next ii
 Set rs1 = Nothing
 Set rs2 = Nothing

 

[nssj]

أخي الكريم أبو خليل .. أحسن الله إليك .. تم الأمر بحمد الله