كود حذف اوتوماتيكي للاسم او الصف الفارغ داخل الجدول

[jack305]

السلام عليكم...اريد مساعدة في  هذا الجدول..الشرح في  الملف  و شكرا

الملف  ينشئ  جدول اوتوماتيكي  بمجرد ادخال الاسماء.....اريد  كود حذف  اوتوماتيكي  للاسم  او الصف الفارغ  داخل الجدول  لكن شرط ان لا يختل  الجدول ...و شكرا

عنوان مخالف ... تم تعديل عنوان المشاركة ليعبر عن طلبك

0.xlsm

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

قم بتفيير اسم الصقحة الى  Salim لحسن نسخ الكود ولصقه بدون مشاكل اللغة العربية

ونقذ هذا الكود 

Option Explicit
Sub Del_Empty()
Dim my_rg As Range
Dim Ro%

With Sheets("Salim")
    Ro = .Cells(Rows.Count, 2).End(3).Row
    .Range("A5").Resize(Ro - 4).ClearContents
    On Error Resume Next
    Set my_rg = _
    .Range("B5:B" & Ro).SpecialCells(xlCellTypeBlanks)
     my_rg.Delete xlUp
    On Error GoTo 0
    Ro = .Cells(Rows.Count, 2).End(3).Row
    .Range("A5").Resize(Ro - 4) = _
    Evaluate("Row(1:" & Ro - 4 & ")")
End With

End Sub

الملف مرفق

jack305.xlsm

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

بعد اضافة الاسماء ( قدر ما تريد منها) أو حذف قدر ما تريد اضغط الزر Run

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

 

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

يا صديقي لا لزوم للدالة طالما الكود يقوم بالترقيم التلقائي

ثم عن اي تنسيق تتكلّم (ارفع صورة بالتنسيق الذي تريده)

[jack305]

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

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

تم التعديل على الملف كما تريد (الدالة تعمل وكذلك التنسيق الشرطي)

و عند الضغط على الزر يقوم الماكرو بازالة الصفوف (الاسماء) الغارغة و  يحافظ على الدالة و التنسيق الشرطي

Option Explicit
Sub Del_Empty_1()
Dim my_rg As Range
Dim Ro%

With Sheets("Salim")
    Ro = .Cells(Rows.Count, 2).End(3).Row
   .Cells.FormatConditions.Delete
    Range("A5:A500").ClearContents
    On Error Resume Next
    Set my_rg = _
    .Range("B5:B" & Ro).SpecialCells(4)
     my_rg.Delete xlUp
    On Error GoTo 0
    Ro = .Cells(Rows.Count, 2).End(3).Row
     
    With .Range("A5").Resize(500)
     .Formula = "=IF(B5="""","""",MAX($A$4:A4)+1)"
     .Resize(, 3).FormatConditions _
     .Add Type:=2, Formula1:="=$B5<>"""""
     .Resize(, 3).FormatConditions(1). _
      Borders.LineStyle = 1
    End With

End With

End Sub

الملف من جدبد

jack305.+with_cond_formatxlsm.xlsm

[jack305]

 

 اخي  الفاضل هل يمكنك وضع  هذا الكود في  هذا الملف  فضلا منك

في  ورقة بيانات الحراس

8.xlsm

تم تعديل أكتوبر 4, 2020 بواسطه jack305

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

و من بفهم شيئاً في هكذا ملف؟؟؟؟

[jack305]

ليس  هذه  الورقة اخي  بل  ورقة  بيانات الحراس

ارفقت صورة

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

ارفع هذه الورقة في ملف مستقل و بدون تنسبق ألوان تبهر النطر و شاشة سوداء يتشائم منها الانسان

و بدون اي كود

[jack305]

اخي  من فضلك اضف الكود على هذه الورقة.

هل من الممكن ان حذفنا اسم تحذف معه جميع المعطيات التي  في  نفس  السطر

9.xlsm

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

تم معالجة الأمر

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

الكود

Option Explicit
Sub Del_Empty_Many_rows()
Dim my_rg As Range
Dim Ro%

With Sheets("Salim")
    Ro = .Cells(Rows.Count, "N").End(3).Row
   .Cells.FormatConditions.Delete
    Range("P9:P500").ClearContents
    On Error Resume Next
    Set my_rg = _
    .Range("N9:N" & Ro).SpecialCells(4)
     
     my_rg.Delete xlUp
     
     'my_rg.EntireRow.Delete
     
     On Error GoTo 0
    Ro = .Cells(Rows.Count, "N").End(3).Row
     
    With .Range("P9").Resize(500)
     .Formula = "=IF(N9="""","""",MAX($P$8:P8)+1)"
     .Offset(, -15).Resize(, 43).FormatConditions _
     .Add Type:=2, Formula1:="=$N9<>"""""
     .Offset(, -15).Resize(, 43).FormatConditions(1). _
      Borders.LineStyle = 1
    End With

End With

End Sub

الملف مرفق

 

Last_Jack.xlsm

[jack305]

شكرا لك اخي  افاضل  ادامك الله

اخي هل يمكن تعديل الكود واظافة تنسيق شرطي اخر  يقوم بتظليل الخلايا  الفارغة باللون الاسود..................................تفضلا منك اخي

اي  يظهر فقط   الجزء الذي  يحتوي  اسماء    و الباقي  اسود  و شكرا  

تم تعديل أكتوبر 5, 2020 بواسطه jack305

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

كيف تطلب التعديل وأنت لم تنزّل الملف حتى

 

[jack305]

اخي  الفاضل فضلك دين في  رقبتي  جزاك الله عني  كل خير سيدي الفاضل

 اريد كيفية بحيث  الكود لا يحذف التنسيقات الشرطيةالتي اظيفها  وشكرا

 

 

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

تفضل ما نريد

Last_Jack_Black.xlsm

[jack305]

حفظك الله من كل سوء

فقط سؤال....

ان اردت  اضافة تنسيقات شرطية لا يحذفها الكود عند الضغط ......كيف افعل

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

الكود يجذف اي تنسيق شرطي
لذلك من اجل   اضافة تنسيقات شرطية لا بد ان يكون ذلك من داخل الكود

[jack305]

ما هي  طريقة اضافة  تنسيق شرطي الى كود باختصار  اخي   

جزاك الله خيرا

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

هذه العملية معقدة بعض الشيئ ولا مجال لشرحها  كتا بة

شاهد هذا الفيديو

https://www.youtube.com/watch?v=F29G18GdTAQ&ab_channel=ExcelDestination

 

[jack305]

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

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

بمكن كتابة كود اخر ثم استدعاءه من الكود الأول

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

هذا مثال حاول تطبيقه في ملف جديد فارغ

Option Explicit
Sub First_Code()
Dim i
Range("A1:B10").ClearContents
For i = 1 To 10
 Range("A" & i) = "First Code: " & i
 Next
 seconde_Code
End Sub
'++++++++++++++++++++++++++++
Sub seconde_Code()
Dim k%
 For k = 1 To 10
 Range("B" & k) = "Seconde Code:" & k
 Next

End Sub

 

[jack305]

اغلب التنسيق الشرطي  الذي اعمل  به هو مثلا الخلية***لا تساوي 0  لون اصفر

او الخلية ***تساوي "" لون احمر  

الخلية***= عدد ما  لون اخضر

اريد فقط ماذا اضيف للكود السابق  في هذه الحالات الثلاث  ان امكن اخي 

تم تعديل أكتوبر 5, 2020 بواسطه jack305

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

قلت لك : حاول تطبيقه في ملف جديد فارغ   
   انه المثال الذي طلبته (استدعاء كود من كود اخر)  جربه  و سترى عمله