هل يمكن عمل ماكرو لحذف الشيكات استحقاق تاريخ اليوم ؟

[جمال حسين رشدان]

السلام عليكم ورحمة الله وبركاته

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

If Range("i11").Value = 1 Then
Range("c11:f11").Value = ""
End If
ولكن هذا امر يطول اذا كان الجدول به 1000 صف مثلا فعلى حد علمي يجب تكرار الامر بالأعلى لكل صف برقمه وهذا امر شاق جدا 

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

ولكم جزيل الشكر مسبقا

حذف الشيكات المستحقة.rarFetching info...

تم تعديل مارس 25, 2018 بواسطه جمال حسين رشدان

[ابراهيم الحداد]

السلام عليكم ورحمة 

استخدم هذا الكود و لا يوجد اى لزوم للمعادلة فى العمود "I"

Sub DelRows()
Dim ws As Worksheet, C As Range
Dim x As Date, LR As Integer, i As Integer
Set ws = Sheets("ورقة1")
LR = ws.Range("F" & Rows.Count).End(xlUp).Row
For i = LR To 11 Step -1
If ws.Cells(i, 6).Value <= Date Then
ws.Cells(i, 6).EntireRow.Delete
End If
Next
End Sub

 

[جمال حسين رشدان]

عذرا اخي العزيز زيزو قمت بنسخ الماكرو وظل الماوس مشغول لفترة ولم يحدث تغيير ممكن ارفاق ملف يكون اوضح وجزاكم الله خيرا

[ابراهيم الحداد]

السلام عليكم ورحمة الله

اليك الملف 

فقط اضغط على الزر الموجود بورقة1

 

حذف الشيكات المستحقة.rar

[جمال حسين رشدان]

شكرا جزيلا اخ زيزو وجاري التجربة

اخي العزيز زيزو الاجراء يقوم بحذف الصفوف بالكامل وبالتالي حذف الجدول والجدول به معادلات اريد ابقاءها

  الذي به خانة الرقم المسلسل  B  مثل عمو

الذي به خانة الايام  G  وعمود

فالمقصود حذف البيانات من الجدول مع الابقاء على الجدول نفسه

ومتأسف على الاثقال عليك

وملاحظة اخرى بعد الضغط على الزر انظر كيف كانت النتيجة في المرفق

 

 

 

 

 

حذف الشيكات المستحقة.rar

[ابراهيم الحداد]

السلام عليكم ورحمة الله

اولا : ضع المعادلة التالية فى الخلية "B11  " ثم اسحب نزولا الى آخر صف

=IF(C11="";"";SUBTOTAL(3;$C$11:C11))

ثانيا ضع الكود التالى بدلا من الكود السابق

Sub DelRows()
Dim ws As Worksheet, C As Range
Dim x As Date, LR As Integer, i As Integer
Application.ScreenUpdating = False
Set ws = Sheets("ورقة1")
LR = ws.Range("F" & Rows.Count).End(xlUp).Row
For i = 11 To LR
If ws.Cells(i, 6).Value <= Date Then
ws.Range(ws.Cells(i, 3), ws.Cells(i, 6)).ClearContents
End If
Next
Application.ScreenUpdating = True
End Sub

 

 

[جمال حسين رشدان]

اخي العزيز زيزو جزاك الله كل خير هذا هو المطلوب

لي سؤال لو سمحت وعذرا على الاطالة

هل يمكن عمل البحث في نطاق صفوف الجدول التي تبلغ حوالي 900 صف وليس البحث في كامل صفوف الورقة لأن هذا يأخذ وقت كبير في البحث وممكن يعمل تهنيج عندي في برنامج اكسيل وجزاكم الله خيرا