اريد دالة او نص برمجى لادراج التواريخ الناقصة فى نفس العمود

[saad hassan]

اريد دالة  او نص برمجى  لادراج التواريخ الناقصة  فى نفس العمود  بالملف المرفق 

saad.xlsxFetching info...

[وجيه شرف الدين]

اتفضل الملف لعله يفى بالغرض

نسخة من saad.xlsxFetching info...

[احمد بدره]

بارك الله فيك أستاذ مصطفى تسلم الأنامل

[سليم حاصبيا]

بعد اذن اخي مصطفى

حل اخر بواسطة  الكود

Option Explicit

Sub get_missing_date()
Dim my_min#, my_max#
Dim cel As Range
Dim Col As Object
Dim i#, m%: m = 2

Range("G2:G" & Rows.Count).ClearContents
Set Col = CreateObject("System.Collections.Arraylist")
With Col
    For Each cel In Range("B2", Range("b1").End(4))
       cel.Value = CDate(cel.Value)
       cel.NumberFormat = "d/m/yyyy"
      .Add CLng(cel.Value)
    Next: .Sort

End With

 my_min = Application.Min(Range("B2", Range("b1").End(4)))
 my_max = Application.Max(Range("B2", Range("b1").End(4)))
 
    For i = my_min + 1 To my_max - 1
      If (IsError(Application.Match(i, Col.toarray, 0))) _
      Then Cells(m, "g") = i: m = m + 1
    Next
    
 Col.Clear: Set Col = Nothing
End Sub

الملف مرفق

 

Missing Dates.xlsmFetching info...

[وجيه شرف الدين]

  في 23‏/4‏/2019 at 18:19, احمد بدره said:

بارك الله فيك أستاذ مصطفى تسلم الأنامل

Expand  

جزاكم الله خير اخى الحبيب على دعمك لى بالتشجيع

  في 23‏/4‏/2019 at 19:05, سليم حاصبيا said:

بعد اذن اخي مصطفى

حل اخر بواسطة  الكود

Option Explicit

Sub get_missing_date()
Dim my_min#, my_max#
Dim cel As Range
Dim Col As Object
Dim i#, m%: m = 2

Range("G2:G" & Rows.Count).ClearContents
Set Col = CreateObject("System.Collections.Arraylist")
With Col
    For Each cel In Range("B2", Range("b1").End(4))
       cel.Value = CDate(cel.Value)
       cel.NumberFormat = "d/m/yyyy"
      .Add CLng(cel.Value)
    Next: .Sort

End With

 my_min = Application.Min(Range("B2", Range("b1").End(4)))
 my_max = Application.Max(Range("B2", Range("b1").End(4)))
 
    For i = my_min + 1 To my_max - 1
      If (IsError(Application.Match(i, Col.toarray, 0))) _
      Then Cells(m, "g") = i: m = m + 1
    Next
    
 Col.Clear: Set Col = Nothing
End Sub

الملف مرفق

 

Missing Dates.xlsm 18.33 \u0643\u064a\u0644\u0648 \u0628\u0627\u064a\u062a · 2 downloads

Expand  

بارك الله فيكم استاذنا الحبيب استاذ سليم  وجعله الله فى ميزان حسناتكم