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

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


nssj
إذهب إلى أفضل إجابة Solved by ابوخليل,

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

الإخوة الكرام .. في الملف المرفق المطلوب ترقيم حقل (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

 

  • Like 3
رابط هذا التعليق
شارك

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

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

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

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

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

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

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

Musnd02.accdb

رابط هذا التعليق
شارك

منذ ساعه, nssj said:

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

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

 

  • Thanks 2
رابط هذا التعليق
شارك

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

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

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")

 

رابط هذا التعليق
شارك

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

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

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

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

100000

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

رابط هذا التعليق
شارك

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

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

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

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

 

For i = 0 To 9999 Step 0
رابط هذا التعليق
شارك

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

 

  • Like 1
رابط هذا التعليق
شارك

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

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

2021-03-15_13h41_54.png.e6c44888d6d05a1bcd8a00abafba8977.png

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

إذا كان جعل الترقيم الثاني يبدأ بـ (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

 

  • Like 1
رابط هذا التعليق
شارك

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