طلب كود لمليء الخلايا الفارغة

[ابومهندالخضري]

السلام عليكم

الملف المرفق فيه مجموعة خلايا

المطلوب كود لمليء الخلايا الفارغة بالعلامة   /  

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

مع فائق الشكر والتقدير للجميع

 

مليء الخلايا الفارغة.rar

[حسين مامون]

استعمل هذا الكود في حدث الشيت

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng
Set rng = Range("b2:f6")
If Not Intersect(Target, rng) Is Nothing Then
If Target = "" Then Target = "/"
End If

End Sub

 

[ابومهندالخضري]

شكرا اخي حسين مامون على الرد والكود الجميل

ولكن عندما وضعت الكود لم تتحول الخلايا الفارغة الى علامة /    الا بعد ان نقرت على مفتاح DEL  على كل الخلايا الفارغة لكي تظهر العلامة    /

كذلك تظهر لي رسالة خطأ عند العمل على الملف ((run time error 13))

وعند تحديد اكثر من خلية والضغط على DEL  تظهر رسالة الخطأ السابقة  ولا تظهر علامة   /

تم تعديل ديسمبر 30, 2019 بواسطه ابومهندالخضري

[حسين مامون]

ضع هذا الكود في حدث thisworkbook

Option Explicit


Private Sub Workbook_Open()
On Error Resume Next
Dim x, r
Dim ws As Worksheet
Set ws = Sheets("ورقة1")
For x = 2 To 6
For r = 2 To 6
If ws.Cells(x, r) = "" Then
ws.Cells(x, r) = "/"
End If
Next
Next

End Sub

وهذا في حدث الشيت

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
Dim rng
Set rng = Range("b2:f6")
If Not Intersect(Target, rng) Is Nothing Then
If Target = "" Then Target = "/"
End If

End Sub

 

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

لا لزوم للحلقات التكراري في هذه الجالة

يكفي هذا الكود البسيط

Sub Fill_Empty()
Range("B2:F6").SpecialCells(4) = "/"
End Sub

 

[أحمد يوسف]

أستاذ

ابومهندالخضري

 

لا اعلم لماذا لا تقوم بالضغط على الإعجاب على الرغم ان كل الإجابات ممتازة ؟!!!! 💙