اخفاء الصف اذا كانت لخلية b و c = صفر بالتنسيق الشرطى والكود

[abouelhassan]

كل عام وانتم بخير اساتذة المنتدى الرائعون

احتاج اخفاء الصف بالتنسيق الشرطى والكود

اذا كانت قيمة الخلية b , c = 0

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

اخفاء الاصفار بالكود والتنسيق الشرطى.xlsm

[abouelhassan]

الاساتذة

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

مع الشكر والاحترام والتقدير

Sub HideRows()
 
Dim rng As Range
Dim cell As Range
Set rng = Range("b2:c250")
 
For Each cell In Selection
    If cell.Value = 0 Or cell.Value = "" Then
        cell.EntireRow.Hidden = True
    End If
Next cell
End Sub

 

[ASUS2020]

عدل السطر هذا 

For Each cell in rng

[abouelhassan]

تمام اخى

بارك الله فيك

فى مشكلة ان الكود يخفى السطر اذا كان احدى الهلايا به صفر واحتاج ان يخفى السطر اذا كان الخليتين بهم0

الاخوة الافاضل اساتذة المنتدى

احتاج معادلة للتنسيق الشرطى لاخفاء الصف اذا كانت نتيجة الخلية b2:c50=0مع الشكر

تم تعديل أغسطس 1, 2020 بواسطه abouelhassan

[عبدالفتاح في بي اكسيل]

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

 

Sub hide()
Dim cell As Range
' For Each cell In ActiveSheet.Range("B2:B250")
For Each cell In ActiveSheet.Range("B2:B250").SpecialCells(xlCellTypeConstants)
 If cell.Value = 0 And cell.Offset(, 1).Value = 0 Then cell.EntireRow.Hidden = true
 Next cell
End Sub

 

تم تعديل أغسطس 2, 2020 بواسطه عبدالفتاح في بي اكسيل

[abouelhassan]

ممتاز استاذ عبد الفتاح يعمل تمام

بارك الله فيك

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

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

1- ليس من الضروري ان يقوم الماكرو بحلقة تكرارية على 250 صف لأنه يمكن ان يكون اكثرها فارغة
    يكفي ان يتوقف عند أول خلية فارغة في العامود الأول

2-هذا الماكرو يقوم بتجميع الصفوف التي تحتوي على صفرين في الذاكرة تم يخفيها دفعة واحدة     اسرع يكثير للبيانات الكبيرة (اكثر من 1000 صف)

3-كودين على نفس الزر     الكبسة الاولى تقوم باخفاء الصفوف  و كبسة اخرى باظهارها (مما يسمح بالتعديل على البيانات)

Option Explicit

Private Sub ToggleButton1_Click()
 If ToggleButton1 Then
hid_rows
ToggleButton1.Caption = "اظهار الكل"
 Else
show_all
ToggleButton1.Caption = "اخفاء الأصفار"
 End If
End Sub
'+++++++++++++++++++++


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
Hide_range.EntireRow.Hidden = True
End If
End Sub
'+++++++++++++++++
Sub show_all()
Range("A1").CurrentRegion.EntireRow.Hidden = False
End Sub

الملف للمعاينة

 

abo_has_hide.xlsm

[abouelhassan]

ايه الجمال والحلاوة والاحترافية دى حاجة وهم والله تسلم ايدك ربنا يبارك فى حضرتك

اللهم امين يارب باشا الاكسيل والله

تسلم يا باشا ربنا يرضى عليك اللهم امين

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

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

اين افضل اجابة؟؟

[abouelhassan]

اجابة حضرتك رائعة 

تسلم ايدك استاذ سليم

الف الف الف الف الف الف شكر

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

والله انا بدعى لك كل يوم  انا عجوز والنظر بعافية شوية مواضيعك ساهمت فى حل اغلب مشاكلى والله الصراحة ربنا يكرمك يارب

وان شاء الله ربنا يتقبل دعائى

ربنا يرضى عنك

[yara ahmed]

ربنا يكرمك استاذ سليم اخى الكريم

[عبدالفتاح في بي اكسيل]

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

[abouelhassan]

ربنا يكرمك استاذ عبد الفتاح الف الف شكر

بارك الله فيك اخى

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

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

مثال اخر (استعمال الفلتر) وتلوين الأصفار

Option Explicit

Private Sub CommandButton1_Click()
 Static t%
 With CommandButton1
    If t Mod 2 = 1 Then
      show_all
      .Caption = "اخفاء الأصفار"
      .BackColor = RGB(0, 176, 0)
    Else
      Hide_by_flter
      .Caption = "اظهار الكل"
      .BackColor = RGB(255, 0, 0)
    End If
 End With
 t = t + 1
End Sub

'++++++++++++++++++++++++++++++++
Sub Hide_by_flter()
Dim Rg As Range, ro
Dim Hd_rg
Set Rg = Range("A1").CurrentRegion

 ro = Rg.Rows.Count
 If ro = 1 Then Exit Sub
With Rg
    .Interior.ColorIndex = 35
    .Borders.LineStyle = 1
    .Font.Bold = True
    .Font.Size = 16
    .AutoFilter 2, "=0"
    .AutoFilter 3, "=0"
    Set Hd_rg = Range("A2:C" & ro - 1).SpecialCells(12)
    .AutoFilter
    Hd_rg.Interior.ColorIndex = 6
    Hd_rg.EntireRow.Hidden = True
End With

 Range("A1:c1").Interior.ColorIndex = 40
End Sub
'+++++++++++++++++
Sub show_all()
Range("A1").CurrentRegion.EntireRow.Hidden = False

End Sub

 

abo_has_hide_by_filter.xlsm

[abouelhassan]

والله ربنا يرضى عنك وينجيك ويخليك ويبارك فيك يا استاذ سليم يا ابن الاصول

يا محترم يا كريم حاجة خرافية وجميلة الالوان بتوضح لى ربنا يرضى عنك ياسيدى ان شاء الله

شكر وتقدير واحترام من اخيك فى الله