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

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

قام بنشر

السلام عليكم - عيد سعيد وتقل الله صيامكم وقيامكم وقراءة القران

اريد جزيتم خيرا

تلوين التاريخ في حالة تاخر الزبون علن التسديد في التاريخ المحدد له 

واذا يوجد وقت ممكن ترحيل المتاخرين الى شيت اخر 

 

المتأخرين عن التسديد.rar

قام بنشر
Option Explicit
Sub give_solotion()
Dim lr As Integer, col, i, k, moth As Integer
Dim My_date As Date
Dim First, Sec As Worksheet
Set First = Sheets("السجل"): Set Sec = Sheets("المتاخرين")
Application.ScreenUpdating = False
lr = First.Cells(Rows.Count, 1).End(3).Row: If lr < 2 Then lr = 2
 First.Range("a2:xfd1000").Interior.ColorIndex = 0
For i = 2 To lr
 col = First.Range("xfd" & i).End(xlToLeft).Column
  For k = 3 To col Step 2
  My_date = First.Cells(i, k)
  moth = Month(My_date)
   If moth = Month(Date) And My_date < Date _
   And First.Cells(i, k).Offset(0, -1) = "" Then
   First.Cells(i, k).Interior.ColorIndex = 3
   First.Cells(i, 1).Interior.ColorIndex = 3
   End If
  Next
Next
Translate_Data
Application.ScreenUpdating = True
End Sub
Sub Translate_Data()
Dim lr As Integer, col, i, k, m, x, moth As Integer
Dim My_date As Date
Dim First, Sec As Worksheet
Dim arr()
Set First = Sheets("السجل"): Set Sec = Sheets("المتاخرين")
lr = First.Cells(Rows.Count, 1).End(3).Row: If lr < 2 Then lr = 2
Sec.Range("a2:M1000").ClearContents
'============================
For i = 2 To lr
 col = First.Range("xfd" & i).End(xlToLeft).Column
  For k = 1 To col Step 2
   If First.Cells(i, k).Interior.ColorIndex = 3 Then
     ReDim Preserve arr(1 To x + 1)
     arr(x + 1) = First.Cells(i, k)
    x = x + 1
   End If
  Next
  If x = 0 Then m = m - 1: GoTo 1

 Sec.Cells(m + 2, 1).Resize(1, x) = arr
1:
  Erase arr: x = 0
  m = m + 1
  Next
'=============================
End Sub

جرب هذا الملف

اضفط فقط على الزر في الصفحة 2

الكود مرفق

تم التعديل على  الاعمدة (ازالة الاعمدة الفارغة)

 

 

 

المتأخرين عن التسديد salim.rar

  • Like 1
قام بنشر (معدل)

عمل متميز - جزيت خيرا

استاذ سليم - طلب - الاعمدة الفارغة هي تحتوي على بيانات فاجتهدت ورفعت البيانات لكي يكون الملف واضح والاعمدة متقاربة لسهولة النظر اليها

حياكم الله ومشكور - كمل معروفك وتعديل الكود حسب الملف الذي ارفقته - بارك الله في وقتك وعمرك وعلمك

 

تم تعديل بواسطه عبدالرحمن عوف
  • Like 1

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