كود اخفاء الصفوف التى تحتوى على صفر يحتاج تعديل

[abouelhassan]

السلام عليكم اساتذة المنتدى

كود اخفاء الصفوف التى تحوى صفر هذا من تنفيذ الاستاذ سليم حاصبيا بارك الله فيه ورزقه كل الخير

احتاج لتغير بالكود ليشمل الصفوف من b5:I50 

بحيث لن الصف بدأ من B5 :I5 اذا كان كله اصفار يختفى حتى لايظهر فى الطباعة

وهكذا لباقى الصفوف 

Sub hid_rows()
Dim Hide_range As Range
Dim i%
i = 2
Range("A1").CurrentRegion.EntireRow.Hidden = False
Do Until Cells(i, 1) = vbNullString
 If Cells(i, 2) = 0 And Cells(i, 3) = 0 Then
   If Hide_range Is Nothing Then
     Set Hide_range = Cells(i, 1)
     Else
     Set Hide_range = Union(Hide_range, Cells(i, 1))
    End If
  End If
i = i + 1
Loop
If Not Hide_range Is Nothing Then
End If
End Sub
'+++++++++++++++++
Sub show_all_rows()
Range("A1").CurrentRegion.EntireRow.Hidden = False
    Range("b5:j50").Select
End Sub

شكر وتقدير واحترام من اخيكم

اخفاء الصفوف الصفرية.xlsm

تم تعديل نوفمبر 26, 2020 بواسطه abouelhassan

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

الكود

Sub hid_rows()
Dim Hide_range As Range
Dim i%
i = 5
Range("A5").CurrentRegion.EntireRow.Hidden = False
Do Until Cells(i, 1) = vbNullString
 If Application.CountIf(Cells(i, 2).Resize(, 9), 0) = 9 Then

   If Hide_range Is Nothing Then
     Set Hide_range = Cells(i, 1)
   Else
     Set Hide_range = Union(Hide_range, Cells(i, 1))
   End If
 End If
i = i + 1
Loop
If Not Hide_range Is Nothing Then
 Hide_range.EntireRow.Hidden = True
End If
End Sub
'+++++++++++++++++
Sub show_all_rows()
Range("A5").CurrentRegion.EntireRow.Hidden = False
    
End Sub

 

[abouelhassan]

شكر وتقدير وخالص الدعاء من اخيك الكود ممتاز الف شكر

بارك الله فيك وزادك من خيره ونعمه

اخيك باحترام

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

Ab_has.xlsm

[abouelhassan]

الف شكر تمام اتقدم لحضرتك بخالص الشكر والدعاء والله 

جعله الله من نصيبك يارب

بارك الله فيك

كل احترامى وتقديرى

اخيك