تعبئة الخلايا الفارغة في الإكسيل

[محمد عدنان]

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

ارجو المساعدة بماكرو يقوم   بتعبئة الخلايا الفارغة في الإكسيل  في الرينج Range("H11:AT75")  باشارة  (  "-")   و شرط ان يكون اخر خلية في العمود B تحتوي على اسم تكون بخط واضح و عريض   اسم الشيت  Table  ؟

الكود التالي للاسناذ الكبير @سليم حاصبيا 

Sub test()
On Error Resume Next
Range("H11:AT75", Range("H11:AT75"). _ End(4)).Offset(, 1). _ SpecialCells(4).Value = "Abscent"
End Sub

هل بالامكان التعديل عليه ليكون الانتهاء  عند اخر قيمة موجودة في العمود b

المصنف1.xlsx

[أ / محمد صالح]

الكود السابق يملأ الخلايا الفارغة كلها بدون شروط

لذا يلزم إضافة شرط

يمكنك استعمال هذا الاجراء

تم إضافة شرط أن تكون خلية العمود B في نفس الصف غير فارغة

Sub masFillBlanks()
Dim rng As Range
For Each rng In Range("H11:AT75")
If Range("b" & rng.Row) <> "" And IsEmpty(rng) Then rng.Value = "-"
Next
MsgBox "Done by mr-mas.com"
End Sub

وهذا نفس الاجراء بطريقة أخرى

Sub masFillBlanks2()
Dim arr, r As Long, c As Long
arr = Range("H11:AT75").Value
For r = LBound(arr, 1) To UBound(arr, 1)
If Range("b" & r + 10) <> "" Then
For c = LBound(arr, 2) To UBound(arr, 2)
If IsEmpty(arr(r, c)) Then Cells(r + 10, c + 7) = "-"
Next c
End If
Next r
MsgBox "Done by mr-mas.com"
End Sub

وأنصح بعدم وجود صفوف أو أعمدة زيادة مثل ما بعد الصف 47 وlما بعد العمود AN

بالتوفيق

[محمد عدنان]

السلام عليكم  ...الاستاذ @أ / محمد صالح  ...كل الاحترام و التقدير لك 

 

[أ / محمد صالح]

ربما يكون سبب بطء الكود (من وجهة نظرك) شرط عدم قراغ خلية العمود b في نفس الصف

وعدم تحديد النطاق الفعلي (بدون زيادة في الصفوف أو الأعمدة)

بالتوفيق