ادراج تواريخ مفقوده

[محمد سعيد رشاد]

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

[ابوبسمله]

ايه المشكله فى الموضوع الاخر الذى تمت الاجابه عليه ؟

برجاء التوضيح اكتر حتى تجد ما تريد ويرجى اضافه مثال لما تريد افضل

 

[jjafferr]

9 ساعات مضت, محمد سعيد رشاد said:

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

رجاء ارفاق مرفق لأننا يجب ان نعمل تجارب ، فالافضل عمله على واقع المشكلة 🙂

 

جعفر

[محمد سعيد رشاد]

اساتذتى  هذا الموضوع ليس له علاقه بالموضوع القديم مرفق  جدول به تورايخ  iهناك تواريخ ليست موجوده  اريد ا عمل انسيرت INSERT لهذه  التواريخ فى مكانها بين التواريخ مع التعديل على باقى السجل

New Microsoft Access Database (2).rar

[محمد أبوعبدالله]

السلام عليكم

تفضل اخي الكريم

On Error GoTo Err:
'1
'===================================================
        mySQL = "Select * From Table1"
        Set rst = CurrentDb.OpenRecordset(mySQL)
'===================================================

'2
    rst.MoveLast
    rstMax = rst!DAT.Value
    rst.MoveFirst
    rstMin = rst!DAT.Value
    rstDate = rstMin
    rstTemp = rstMin
    rst.MoveNext
'===================================================

'3
    While rst.EOF = False And rstTemp < rstMax
          rstTemp = rst!DAT.Value
          XNew = DateAdd("d", 1, rstDate)
                Do While DateDiff("d", XNew, rstTemp) >= 1 And XNew < rstMax
                  rst.AddNew
                  rst!DAT.Value = XNew
                  rst.Update
                  XNew = DateAdd("d", 1, XNew)
                  Debug.Print XNew
                Loop
              rstDate = rstTemp
              rst.MoveNext
            Wend
            MsgBox "تم اضافة التواريخ المفقودة بنجاح", vbInformation, "Officena"
'===================================================
Err:
    MsgBox "لا توجد بيانات في الجدول", vbInformation, "Officena"

New Microsoft Access Database (2).rar

تحياتي

وهذه نفس الطريقة ولكن لاضافة التواريخ المفقودة في جدول منفصل

On Error GoTo Err:
'1
'===================================================
        mySQL = "Select * From Table1"
        Set rst = CurrentDb.OpenRecordset(mySQL)
        
        mySQL3 = "Select * From Tablel3"
        Set rst3 = CurrentDb.OpenRecordset(mySQL3)
'===================================================

'2
    rst.MoveLast
    rstMax = rst!DAT.Value
    rst.MoveFirst
    rstMin = rst!DAT.Value
    rstDate = rstMin
    rstTemp = rstMin
    rst.MoveNext
'===================================================

'3
    While rst.EOF = False And rstTemp < rstMax
          rstTemp = rst!DAT.Value
          XNew = DateAdd("d", 1, rstDate)
                Do While DateDiff("d", XNew, rstTemp) >= 1 And XNew < rstMax
                  rst3.AddNew
                  rst3!DAT.Value = XNew
                  rst3.Update
                  XNew = DateAdd("d", 1, XNew)
                  Debug.Print XNew
                Loop
              rstDate = rstTemp
              rst.MoveNext
            Wend
            MsgBox "تم اضافة التواريخ المفقودة بنجاح", vbInformation, "Officena"
'===================================================
Err:
    MsgBox "لا توجد بيانات في الجدول", vbInformation, "Officena"

New Microsoft Access Database (2).rar

تحياتي

[ابوبسمله]

رائع اخى واستاذى @محمد أبوعبدالله جزاك الله خيرا

وهذا الموضوع شبه المطلوب ولكن للاشهر لاخى واستاذى @ابو تراب جزاه الله خيرا

والتعديل ليتناسب مع طلب الموضوع

Private Sub btnGenerate_Click()
Dim rs As DAO.Recordset
Dim fromDate As Date
Dim toDate As Date

   Set rs = CurrentDb.OpenRecordset("table1")
   While Not rs.EOF
        fromDate = rs("DAT")
        rs.MoveNext
        If Not rs.EOF Then
            toDate = rs("DAT")
            addMissingMonths fromDate, toDate
        End If
   Wend
       
End Sub

Public Sub addMissingMonths(ByVal fromDate As Date, ByVal toDate As Date)
Dim missingDate As Date
Dim missingMonths As Integer
Dim i As Integer

    missingMonths = DateDiff("d", fromDate, toDate) - 1
'    missingMonths = DateDiff("m", fromDate, toDate) - 1
    
    For i = 1 To missingMonths
        missingDate = DateAdd("d", i, fromDate)
'        missingDate = DateAdd("m", i, fromDate)
        Me.lstMissingMonths.AddItem missingDate
        DoCmd.SetWarnings False
        DoCmd.RunSQL "INSERT INTO Table1 ( DAT ) values (" & Format(missingDate, "\#mm\/dd\/yyyy\#") & ");"
        DoCmd.SetWarnings True
    
    Next
    
End Sub

يالتوفيق اخوانى

[Hawiii]

زيادة الخير  خيرين
مع الاعتذار من الأساتذة الذين سبقوني ، فكما يقال : كل الطرق تؤدي إلى روما
 

Sub MissingDatesAdd()
  Dim dbs As Database
  Dim rst As Recordset
  Dim LastDate As Long
  Dim Rows As Long
  Dim NewRow As Long
  Dim Count As Long
  
  Set dbs = CurrentDb
  Set rst = dbs.OpenRecordset("Table1", dbOpenDynaset)
  rst.Sort = "DAT"
  Set rst = rst.OpenRecordset
  
  With rst
    .MoveFirst
    LastDate = !DAT
    .MoveNext
    
    Do While Not .EOF
      LastDate = LastDate + 1
      Rows = CLng(!DAT)
      
      If Rows > LastDate Then
        Rows = Rows - LastDate
        Count = Count + Rows
        
        For NewRow = 1 To Rows
          .AddNew
            !DAT = LastDate + NewRow - 1
            !Test = "Was missing"
          .Update
        Next NewRow
        
        LastDate = !DAT
      End If
      
      .MoveNext
    Loop
  End With
  
  rst.Close
  Set dbs = Nothing
  
  MsgBox "تم إضافة " & Count & " سجلا"
End Sub

 

[محمد سعيد رشاد]

اخى واستاذى @محمد أبو عبد الله واخى واستاذى @احمد الفلاحجي واخى واستاذى @Hawiii  جزاكم الله خيرا وجعل علمكم فى ميزان حسناتكم