اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
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

انشئ حساب جديد او قم بتسجيل دخولك لتتمكن من اضافه تعليق جديد

يجب ان تكون عضوا لدينا لتتمكن من التعليق

انشئ حساب جديد

سجل حسابك الجديد لدينا في الموقع بمنتهي السهوله .

سجل حساب جديد

تسجيل دخول

هل تمتلك حساب بالفعل ؟ سجل دخولك من هنا.

سجل دخولك الان
  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information