مطلوب ادراج الارقام المفقودة وتعديل ما بعدها

[ابوخليل]

السلام عليكم 

احبتي في المرفق جدول يحتوي على حقل رقمي مكرر  ، وقد سقطت بعض الارقام 

وايضا مرفق صورة بالارقام  المفقودة الساقطة

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

مثلا  اول رقم مفقود هو 422 حيث ستجد في الجدول  الرقم 421 ويليه الرقم 423

فالمطلوب هو تعديل الرقم 423 ليصبح 422  ثم الذي بعده هو 424 يتم تعديله ليصبح 423 ... وهكذا

علما ان كثير من هذه الارقام مكررة

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

يمكن ان نعملها يدويا .. ولكن العمل اليدوي معرض للخطأ 

 

Copy.accdb

[ابوخليل]

ملحوظة : لا اريد ادراج الارقام المفقود في سجلات جديدة وانما اريد الاستبدال يعني : التصحيح

[jjafferr]

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

 

حيا الله اخوي ابوخليل 🙂

في الواقع انت تريد اول رقم فقط ، ومنه تقوم بتعديل باقي الارقام ، صح ؟

الاستعلام qry_Missing_Numbers يعطيك الارقام المفقودة ، هذه خطوة اولى 🙂

 

جعفر

1380.Missing_Copy (1).accdb.zip

[SEMO.Pa3x]

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

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

 

حيا الله اخوي ابوخليل 🙂

في الواقع انت تريد او رقم فقط ، ومنه تقوم بتعديل باقي الارقام ، صح ؟

الاستعلام qry_Missing_Numbers يعطيك الارقام المفقودة ، هذه خطوة اولى 🙂

 

جعفر

1380.Missing_Copy (1).accdb.zip 31.52 kB · 5 downloads

ربما حان الوقت لإستخدام العتاد الثقيل RecordSet 

[ابو جودي]

طيب هل ممكن نعمل لوب بشرط

يبدأ اللوب من السجل الاول والشرط ان كان الرقم فى السجل التالى = الرقم فى السجل الحالى  او ان كان الرقم فى السجل التالى اكبر من الرقم فى السجل الحالى +1 يستكمل اللوب
والا ان كان الرقم فى السجل التالى اكبر من الرقم فى السجل الحالى +2 يتم يتوقف اللوب ويتم تحديث هذا الرقم برقم السجل السابق +1 ويبدأ اللوب من جديد 

[ابو جودي]

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

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

Dim RS      As DAO.Recordset
Dim crntRS  As Integer
Dim nextRS  As Integer

Set RS = CurrentDb.OpenRecordset("tblName")

If Not RS.EOF Then RS.MoveFirst

Do Until RS.EOF
    crntRS = RS![IDNo]
    
    RS.MoveNext
    
    nextRS = RS![IDNo]
    
    If nextRS > crntRS + 2 Then
        RS.MovePrevious
            RS.Edit
                RS![IDNo] = crntRS + 1
            RS.Update
        RS.MoveFirst
    Else
        RS.MoveNext
    End If
Loop
   
MsgBox "Done!", vbInformation, "Completed"

 

[husamwahab]

مشاركة مع اساتذي الاعزاء

تفضل هذه المحاولة ارجو ان تكون موفقة

Copy2.rar

[ابوخليل]

For i = 1 To k
    Rs.Edit
    If Rs!planNo < 566 Then
      Rs!planNo = Rs!planNo - 1
    ElseIf Rs!planNo > 566 And Rs!planNo < 822 Then
      Rs!planNo = Rs!planNo - 2
    ElseIf Rs!planNo > 822 And Rs!planNo < 877 Then
      Rs!planNo = Rs!planNo - 3
    ElseIf Rs!planNo > 877 And Rs!planNo < 972 Then
      Rs!planNo = Rs!planNo - 4
    ElseIf Rs!planNo > 972 And Rs!planNo < 1788 Then
      Rs!planNo = Rs!planNo - 5
    ElseIf Rs!planNo > 1788 Then
      Rs!planNo = Rs!planNo - 6
    End If
    Rs.Update
    Rs.MoveNext
  Next i

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

شكرا جزيلا  لك 

[jjafferr]

السلام عليكم 🙂

 

واليك طريقتي ، فهي تعتمد على اول رقم مفقود ، وقد لا تكون الاسرع 🙂 

Public Function ReArrange()

    Dim rst As DAO.Recordset
    Dim RC As Long
    Dim First_Missing As Long
    Dim Last_Record As Long
    Dim Previous_Record As Long
    Dim Update_to As Long
    Dim i As Long
    Dim mySQL As String
    
    Set rst = CurrentDb.OpenRecordset("Select [jint] From [qry_Missing_Numbers]")
    First_Missing = rst!jint
    
   
    Set rst = CurrentDb.OpenRecordset("Select [planNo] From [tblKotah] Where [planNo]>=" & First_Missing & " Order By [planNo]")
    rst.MoveLast: Last_Record = rst!planNo
    rst.MoveFirst: RC = rst.RecordCount
    
    
    'lets get to work
    DoCmd.SetWarnings False
    
    Update_to = First_Missing - 1
    Do Until rst.EOF
            

        If Previous_Record = rst!planNo Then
            'Update_to = Update_to
        Else
            Update_to = Update_to + 1
            
            mySQL = "UPDATE tblKotah SET planNo =" & Update_to & " WHERE planNo = " & rst!planNo
            DoCmd.RunSQL mySQL
        
        End If
               
        
        If Previous_Record = rst!planNo Then
            'GoTo Move_Next
        Else
            Previous_Record = rst!planNo
        End If

        
        rst.MoveNext
    Loop
    
    DoCmd.SetWarnings True
    rst.Close: Set rst = Nothing
    
    MsgBox "Done"
End Function

.

وبعد اتمام العمل ، تستطيع استعمال الاستعلام qry_Missing_Numbers  للتأكد ان جميع السجلات مسلسلة 🙂

 

جعفر

1380.Missing_Copy (1).accdb.zip

[jjafferr]

منذ ساعه, husamwahab said:

تفضل هذه المحاولة ارجو ان تكون موفقة

تحليل جميل للارقام 🙂

 

جعفر

[jjafferr]

8 ساعات مضت, ابوخليل said:

شكرا لكم احبتي على جهدكم ووقتكم الثمين الذي بذلتوه .. أسأل الله الكريم ان يجزيكم عنا خير الجزاء

حياك الله اخوي ابوخليل 🙂

 

ولو اني ما فهمت الشرح ، ولكن انت ادرى ببياناتك 🙂

 

جعفر

[husamwahab]

بالخدمة استاذابوخليل

11 hours ago, jjafferr said:

تحليل جميل للارقام 🙂

تسلم استاذي العزيز جعفر

وهذا بعض ماعندكم