ارجو اعطائي درس في فن التكرر و التسلسل جملة او كلمة او حرف متكرر مع تسلسل ارقام و احرف متتالية

[ابوعبدالله_1972]

ارجو  شرح لي درس في التكرار احرف مع تسلسل مثال (AA-00) الى (ZZ-99) يكون التكرار يبداء AA-02 / AA-01 / AA-00 و AB-9 الى ZZ-99 

بفكرة اخري عندي جدول اريد عمل تكويد احرف و ارقام متسلسلة و احرف متالية 0-A الى ZZZZZ-99999 

وشكرا

[ابوعبدالله_1972]

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

[husamwahab]

السلام عليكم استاذ ابو عبد الله

طلبك هو تسلسل يعتمد على تغير الرقم والحرف

بهذه الحالة هناك طريقتين 

الاولى : ثبات الحرف وتغير الرقم وصولا الى الرقم 99999 ثم يبدا الترقيم من جديد مع حرف جديد

الثانية : ثبات الرقم وتغير الحروف وصولا الى

zzzzz

ثم يبدا الترقيم من جديد مع رقم جديد

فالامر يشبه ورقة الاكسل الاولوية للصف ام للعمود

احد الامثلة يشير الى الطريقة الاولى لكن للتاكد اي الطريقتين طلبك

وعذرا للاطالة

DB.rar

تم تعديل يوليو 29, 2021 بواسطه husamwahab

[د.كاف يار]

وهذه مشاركتي مع اخواني

 

Loop.accdb

[ابوعبدالله_1972]

شكرا بارك الله فيكم .... التكرار اخواني الجدولين ممتازين (فقط اريد حاجتين التكرار و التبديل للاحرف و التبديل بينها من AA00,AA99-AB00,AB99-BA00, الى ZZ99

وثانيا الى ادراجها في جدول TAB في الاكسس ) ..  مطلوبه يوم السبت في الجامعة ... وشكراً

تم تعديل يوليو 29, 2021 بواسطه ابوعبدالله_1972

[Hawiii]

جرب هذا الكود:
 

Function NextCode(PrevCode As String) As String
  Dim fL As String
  Dim sL As String
  Dim No As Byte
  
  'Validation
  NextCode = PrevCode
  If Len(PrevCode) <> 4 Then Exit Function
  If Not IsNumeric(Right(PrevCode, 2)) Then Exit Function
  
  fL = Mid(PrevCode, 1, 1)
  sL = Mid(PrevCode, 2, 1)
  No = Mid(PrevCode, 3, 2)
  
  If Not fL Like "[A-Z]" Then Exit Function
  If Not sL Like "[A-Z]" Then Exit Function
  
  'Start Coding ----------------------------------
  If No < 99 Then
    No = No + 1
    NextCode = fL & sL & Format(No, "00")
    Exit Function
  End If
  
  If sL < "Z" Then
    No = 1
    sL = Chr(Asc(sL) + 1)
    NextCode = fL & sL & Format(No, "00")
    Exit Function
  End If
  
  If fL < "Z" Then
    No = 1
    fL = Chr(Asc(fL) + 1)
    NextCode = fL & sL & Format(No, "00")
    'Exit Function
  End If
End Function

Sub test()
  Dim Seq As Integer
  Dim NewCode As String
  
  NewCode = "AA00"
  For Seq = 1 To 10000
    NewCode = NextCode(NewCode)
    Debug.Print NewCode
    If NewCode = "ZZ99" Then Exit For
  Next Seq
End Sub

في حالة أن أردت الرقم يبدأ من صفر بدل السطرين من No = 1 إلى No = 0

[husamwahab]

تفضل التعديل

 

DB-1.rar

[abouelhassan]

43 دقائق مضت, husamwahab said:

تفضل التعديل

 

DB-1.rar 84.38 kB · 1 download

بارك الله فيك استاذنا الفاضل

احترام وتقدير من اخيك

[ابوعبدالله_1972]

اسعد الله ايامكم في هذا الجدمعة المباركة و يجعلكم ربي من المبروكين بذن الله العلي الكريم

Hawiii استاذي لا اعرف كيف اكتب الاكود .. ممكن تكمل جميلك و ترسلها لي

[Hawiii]

أنا لا أعرف مطلبك بالضبط ، فإذا مطلبك فقط هو حلقات تكرارية من البداية إلى النهاية دفعة واحدة وتحفظ في جدول فعليك بمثال أخينا @husamwahab فهو مثال ممتاز.

عن مثالي:
مثالي هو دالة تولد كود جديد للسجل التالي بناء على الكود الحالي أو المعطى.
وأستطيع أن أصنع لك آخر للسجل السابق بحيث تستطيع التقليب بني الأكواد دون الحاجة لتخزينها ودون أن تضطر أن تبدأ من أصغر/أول كود في السلسلة.
ويمكنك كذلك استعراض كامل السلسلة بعمل إجراء إضافي.

إذا رغبت في فكرتي فأخبرني كيف تريد المثال ، هل تريد نموذج "فورم" يأخذ منك أحد الأكواد ثم يظهر لك الكود السابق والكود الحالي؟

وأرجع وأؤكد عليك في حالة رغبتك فقط إضافة كامل السلسلة في جدول فعليك بمثال حسام.
أنتظر ردك.

[د.كاف يار]

منذ ساعه, Hawiii said:

أنا لا أعرف مطلبك بالضبط ، فإذا مطلبك فقط هو حلقات تكرارية من البداية إلى النهاية دفعة واحدة وتحفظ في جدول فعليك بمثال أخينا @husamwahab فهو مثال ممتاز.

عن مثالي:
مثالي هو دالة تولد كود جديد للسجل التالي بناء على الكود الحالي أو المعطى.
وأستطيع أن أصنع لك آخر للسجل السابق بحيث تستطيع التقليب بني الأكواد دون الحاجة لتخزينها ودون أن تضطر أن تبدأ من أصغر/أول كود في السلسلة.
ويمكنك كذلك استعراض كامل السلسلة بعمل إجراء إضافي.

إذا رغبت في فكرتي فأخبرني كيف تريد المثال ، هل تريد نموذج "فورم" يأخذ منك أحد الأكواد ثم يظهر لك الكود السابق والكود الحالي؟

وأرجع وأؤكد عليك في حالة رغبتك فقط إضافة كامل السلسلة في جدول فعليك بمثال حسام.
أنتظر ردك.

ماشاء الله عليك فناااان 

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

3 ساعات مضت, Hawiii said:

في حالة أن أردت الرقم يبدأ من صفر بدل السطرين من No = 1 إلى No = 0

سؤال مهم اذا حبيت ان الرقم يبدء من صفرين كيف الطريقة 001 - 002 و يكون قبلها الأحرف

[Hawiii]

وجدت خطأ في الكود السابق ، ياريت من الإداريين حذفه
أنا الآن أفحص الكود وقد أضفت عليه زيادات وكذلك عملت دالة أخرى لتعطينا الكود السابق.

5 دقائق مضت, د.كاف يار said:

سؤال مهم اذا حبيت ان الرقم يبدء من صفرين كيف الطريقة 001 - 002 و يكون قبلها الأحرف

إذن لننتهي من قضاء حاجة السائل ، وسأبدأ بتطوير الدالتين فورا بمزيد من الخيارات إن شاء الله.

[Hawiii]

الكود بعد التصحيح
 

Function NextCode(ByVal PrevCode As Variant) As String
  Dim fL As String
  Dim sL As String
  Dim No As Byte
  
  'Validation ----------------------------------
  NextCode = ""
  PrevCode = Trim(Nz(PrevCode, ""))
  If PrevCode = "" Then
    NextCode = "AA01"
    Exit Function
  End If
  
  If Len(PrevCode) <> 4 Then Exit Function
  If Not IsNumeric(Right(PrevCode, 2)) Then Exit Function
  
  fL = Mid(PrevCode, 1, 1)
  sL = Mid(PrevCode, 2, 1)
  No = Mid(PrevCode, 3, 2)
  
  If Not fL Like "[A-Z]" Then Exit Function
  If Not sL Like "[A-Z]" Then Exit Function
  
  'Start Coding ----------------------------------
  If No < 99 Then
    No = No + 1
    NextCode = fL & sL & Format(No, "00")
    Exit Function
  End If
  
  If sL < "Z" Then
    No = 1
    sL = Chr(Asc(sL) + 1)
    NextCode = fL & sL & Format(No, "00")
    Exit Function
  End If
  
  If fL < "Z" Then
    No = 1
    sL = "A"
    fL = Chr(Asc(fL) + 1)
    NextCode = fL & sL & Format(No, "00")
    'Exit Function
  End If
End Function


Sub TestNext()
  Dim rst As Recordset
  Dim Seq As Long
  Dim NewCode As String
  
  DoCmd.RunSQL "Delete * from Table1;"
  Set rst = CurrentDb.OpenRecordset("Table1", dbOpenDynaset)

  NewCode = ""
  With rst
    For Seq = 1 To 100000
      NewCode = NextCode(NewCode)
      .AddNew
        !Seq = Seq
        !Code = NewCode
      .Update
      If NewCode = "ZZ99" Then Exit For
    Next Seq
  End With
  
  rst.Close
  MsgBox "Done"
End Sub

 

[Hawiii]

مثال مرفق

 

Hawiii-Loop-01.accdb

[طلب اكسس]

2 ساعات مضت, Hawiii said:

الكود بعد التصحيح
 

Function NextCode(ByVal PrevCode As Variant) As String
  Dim fL As String
  Dim sL As String
  Dim No As Byte
  
  'Validation ----------------------------------
  NextCode = ""
  PrevCode = Trim(Nz(PrevCode, ""))
  If PrevCode = "" Then
    NextCode = "AA01"
    Exit Function
  End If
  
  If Len(PrevCode) <> 4 Then Exit Function
  If Not IsNumeric(Right(PrevCode, 2)) Then Exit Function
  
  fL = Mid(PrevCode, 1, 1)
  sL = Mid(PrevCode, 2, 1)
  No = Mid(PrevCode, 3, 2)
  
  If Not fL Like "[A-Z]" Then Exit Function
  If Not sL Like "[A-Z]" Then Exit Function
  
  'Start Coding ----------------------------------
  If No < 99 Then
    No = No + 1
    NextCode = fL & sL & Format(No, "00")
    Exit Function
  End If
  
  If sL < "Z" Then
    No = 1
    sL = Chr(Asc(sL) + 1)
    NextCode = fL & sL & Format(No, "00")
    Exit Function
  End If
  
  If fL < "Z" Then
    No = 1
    sL = "A"
    fL = Chr(Asc(fL) + 1)
    NextCode = fL & sL & Format(No, "00")
    'Exit Function
  End If
End Function


Sub TestNext()
  Dim rst As Recordset
  Dim Seq As Long
  Dim NewCode As String
  
  DoCmd.RunSQL "Delete * from Table1;"
  Set rst = CurrentDb.OpenRecordset("Table1", dbOpenDynaset)

  NewCode = ""
  With rst
    For Seq = 1 To 100000
      NewCode = NextCode(NewCode)
      .AddNew
        !Seq = Seq
        !Code = NewCode
      .Update
      If NewCode = "ZZ99" Then Exit For
    Next Seq
  End With
  
  rst.Close
  MsgBox "Done"
End Sub

 

منطقيا و عمليا لا فائدة من هذا العمل 

مجهود و ضياع وقت دون فائدة

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

عيني ما اقصد في الكلام لكن هذا واقع بشكل كبير في المنتدى

[ابوعبدالله_1972]

اسعد الله ايامكم في هذا الجمعة المباركة و يجعلكم ربي من المبروكين بذن الله العلي الكريم

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

كلامك 100% و لكن احد اولادي  قسم علوم السياسة و الاقتصاد ليس لها في الكمبيوتر اي علم و لكن استاذ المادة (( اسمها تكود العناوين )) طلب منا هذا الملف بنفس هذا الصيغة و الاضافات المضافة في الملف

 

اسال الله العلي القدير ان يبارك لكم في علمكم و ابنائكم و صحتكم و مالكم و كل من يعزي على قلبكم
اطلب من الله ثم منكم ارفقت جدول عمل من عملكم معدل علية بعض الاضافات المطلوبة اريد من الله ثم منكم ان يتم العمل عليه ((اطلب من الله ثم منكم الا تنسوني و الرد بارك الله فيكم )

 

 

DB-1-بعد الاضافة.zip

[Hawiii]

49 دقائق مضت, ابوعبدالله_1972 said:

 

 

DB-1-بعد الاضافة.zip 421.93 kB · 1 download

ارفع الملف بإصدار 2007 أو أقل 
علما إذا أردت التعديل على عمل غيري فأنا أعتذر ، فالمبرمج للمثال هو أولى بتكملة طلبك.

[Hawiii]

منذ ساعه, طلب اكسس said:

منطقيا و عمليا لا فائدة من هذا العمل 

مجهود و ضياع وقت دون فائدة

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

عيني ما اقصد في الكلام لكن هذا واقع بشكل كبير في المنتدى

هو مثال للترميز/التكويد وهو مطلوب لبرامج البنوك والمحاسبة والمخازن وخصوصا البرامج التي ترمز بنظام الشرائح Segments.
وليس كل ما تدرسه/تتعلمه لا بد من تطبيقه في حياتك العملية فيكفيها أنها تساعد على نمو قدراتك في تفكيك وبناء كل شائك يعترض مسيرتك العملية.

[husamwahab]

تفضل هذه المحاولة حسب فهمي لطلبك

 

DB-2.rar

[ابوعبدالله_1972]

اسال الله رب العرش العظيم و اسال ان يبارك فيكم جميعا و عزكم و اكرمكم شكر لكم (يقول عليه الصلاة و السلام لايشكر الله من لايشكر الناس) شكر الف شكر لكم بارك الله فيكم و رزقكم الله بصحة و تنزل عليكم البركات حبيب قلبي طلب صغير اعلم باني تثاقلت عليكم بطلبات ..و اطلب من الله ثم منكم تكملة الجميل

(ان علطان في البداية و لايكون في نفسكم اي شئ ...  :-

عدد الاحرف لايساوي عدد الاقام ممكن تزيد الارقام او ويقل عدد الحروف و العكس كذلك (مطلوب فعلاً). مثلا الاحرف البداء 5 و الانتهاء 5
الاحرف ممكن صغيرة و كبيرة . و الارقام البداء 3 و الانتهاء 3 ارقام و الكمية مفتوحة . و يعطني كل تنبية الوحده . (يستمر (نعم/لا) ؟

و يعطني كل تنبية الوحده . (يستمر (نعم/لا) ؟

1 = ان عدد الارقام مختلف مع عدد الحروف.            يعطني تنبية الوحده . (يستمر (نعم/لا) ؟                                  
2 = ان عدد الحروف مختلف عدد الارقام.            يعطني تنبية الوحده . (يستمر (نعم/لا) ؟
3 = ان عدد الارقام في البداء يختلف في الانتهاء (في البدء 2 و النهاية 3) ؟     يعطني تنبية الوحده . (يستمر (نعم/لا) ؟
4 = ان عدد الارقام في البداء اكثر من النهاية  (في البدء 3 و النهاية 2) ؟     (يرفض) يجب تعديل الارقام في البداية تكون اقل من النهاية او متساوي العدد                          
5 = ان عدد الاحرف في البداء يختلف في الانتهاء.  يعطني تنبية الوحده . (يستمر (نعم/لا) ؟
6 = ان عدد الاحرف في الانتهاء يختلف في البداء.(عدد الاحرف في النهاية اقل من البداية) ؟(يرفض)يجب تعديل الادخالات عددللاحرف في البدايةتكون اقل من النهايةاو متساوي العدد
7 = ان حجم (حرف صغيراوكبير) الاحرف في البداء يختلف في الانتهاء. ؟ يعطني تنبية الوحده . (يستمر (نعم/لا) ؟
8 = ان حجم (حرف صغيراوكبير) الاحرف في الانتهاء يختلف في البداء. ؟ يعطني تنبية الوحده . (يستمر (نعم/لا) ؟

 

و اعتذر منكم و لكم خالص التقدير و الشكر ؟ 

[ابوعبدالله_1972]

لاحول و قوة الا الله (لله المشتكي)

تم تعديل يوليو 31, 2021 بواسطه ابوعبدالله_1972