اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

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


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

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

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

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

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

9 ساعات مضت, احمد بدره said:

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

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

9 ساعات مضت, سليم حاصبيا 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

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

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

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