إخفاء الصفوف اذ كانت فارغة

[محمد الورفلي1]

السلا م عليكم

و سمحتو اريد اخفاء الصفوف اذ كانت فارغة او التي  يوجد بها صفرمن النطاق c13 الى C65512

وجدت هذا الكود لكنه بطئ جداً يستغرق وقت كبير لاخفاء الصفوف واحيناً يقف الاكسل عن الاستجابة

Sub ÇÎÝÇÁ()
Application.ScreenUpdating = False
 For Each cl In Range("c13:cC65512")
With cl
If .Value = 0 Then .Rows.EntireRow.Hidden = True Else .Rows.EntireRow.Hidden = False
End With
Next
      
Application.ScreenUpdating = True
End Sub

 

الخزينة.rar

[رجب جاويش]

أخى محمد

جرب الكود التالى

Sub ragab()
Dim rng As Range
Dim rng1 As Range
Dim cl As Range
On Error Resume Next
Application.ScreenUpdating = False
Set rng = Range("c13:c65512").SpecialCells(xlCellTypeBlanks)
rng.EntireRow.Hidden = True

Set rng1 = Range("c13:c65512").SpecialCells(xlCellTypeVisible)
For Each cl In rng1
If cl.Value = 0 Then
cl.EntireRow.Hidden = True
End If
Next
Application.ScreenUpdating = True
End Sub

 

الخزينة.rar

تم تعديل يناير 26, 2016 بواسطه رجب جاويش

[مهند الزيدي]

شكر خاص الإخ رجب جاويش

عودة أكثر من رائعة..

أخي رجب ممكن كود يقوم بإخفاء الإعمدة عندما تكون خلية قي الصف تساوي صفر

مثلا إذا كانت الخلية A20 =0 يقوم بأخفاء العمود    A  وكذلك بقية الاعمدة الى مثلا Z  حسب قيمة الخلية 20 فيه

تم تعديل يناير 26, 2016 بواسطه مهند الزيدي

[ياسر خليل أبو البراء]

أخي الكريم مهند

لما لا تطرح موضوع جديد لتجد استجابة أكثر مع التوضيح التام لطلبك مع إرفاق لشكل النتائج المتوقعة إذا تطلب الأمر

 

أخي الحبيب رجب جاويش

حاول أن تبتعد قدر الإمكان عن الحلقات التكرارية لما لها من أثر في بطء عمل الكود خصوصاً إذا كانت البيانات كبيرة

ما رأيك بفكر جديد وهو استخدام خاصية الفلترة ..جرب الكود التالي

Sub HideRowsUsingFilterMethod()
    Dim Rng As Range
    
    Application.ScreenUpdating = False
        On Error Resume Next
        With ActiveSheet
            .AutoFilterMode = False
            .Range("C12:C65512").AutoFilter Field:=1, Criteria1:="=0", Operator:=xlOr, Criteria2:=""
            Set Rng = .Range("C13:C65512").SpecialCells(xlCellTypeVisible)
            .AutoFilterMode = False
            Rng.EntireRow.Hidden = True
        End With
    Application.ScreenUpdating = True
End Sub

تقبل تحياتي

 

[رجب جاويش]

أخى الحبيب ياسر

معك حق طبعا فى ان الحلقات التكرارية تؤدى الى بطء الكود

لذا قمت بحذف الصفوف الفارغة اولا بعيدا عن الحلقات التكرارية

وتبقت الخلايا المحتوية على الصفر فقط وهى عددها أقل للحلقات التكرارية

أجمل تحياتى لفكرتك الجميلة باستخدام الفلترة

 

 

أخى مهند

برجاء فتح موضوع جديد كما أخبرك أخى ياسر

 

[محمد الورفلي1]

13 ساعات مضت, رجب جاويش said:

أخى محمد

جرب الكود التالى

Sub ragab()
Dim rng As Range
Dim rng1 As Range
Dim cl As Range
On Error Resume Next
Application.ScreenUpdating = False
Set rng = Range("c13:c65512").SpecialCells(xlCellTypeBlanks)
rng.EntireRow.Hidden = True

Set rng1 = Range("c13:c65512").SpecialCells(xlCellTypeVisible)
For Each cl In rng1
If cl.Value = 0 Then
cl.EntireRow.Hidden = True
End If
Next
Application.ScreenUpdating = True
End Sub

 

الخزينة.rar

شكراً استاذ رجب ...عفواً الكود يعمل بشكل سريع

12 ساعات مضت, ياسر خليل أبو البراء said:

أخي الكريم مهند

لما لا تطرح موضوع جديد لتجد استجابة أكثر مع التوضيح التام لطلبك مع إرفاق لشكل النتائج المتوقعة إذا تطلب الأمر

 

أخي الحبيب رجب جاويش

حاول أن تبتعد قدر الإمكان عن الحلقات التكرارية لما لها من أثر في بطء عمل الكود خصوصاً إذا كانت البيانات كبيرة

ما رأيك بفكر جديد وهو استخدام خاصية الفلترة ..جرب الكود التالي

Sub HideRowsUsingFilterMethod()
    Dim Rng As Range
    
    Application.ScreenUpdating = False
        On Error Resume Next
        With ActiveSheet
            .AutoFilterMode = False
            .Range("C12:C65512").AutoFilter Field:=1, Criteria1:="=0", Operator:=xlOr, Criteria2:=""
            Set Rng = .Range("C13:C65512").SpecialCells(xlCellTypeVisible)
            .AutoFilterMode = False
            Rng.EntireRow.Hidden = True
        End With
    Application.ScreenUpdating = True
End Sub

تقبل تحياتي

 

استاذ ياسر بارك الله فيك ... اعتق هنا مشكلة عند الظغط مثلاً بالخطاء على مفتاح الاخفاء مره اخرى والصفوف مختفية يحصل ايقاف وثقل للاكسل بشك كبير ... هل هذا لانه 2003

ام هناك مشكلة معينة

[ياسر خليل أبو البراء]

أخي الكريم محمد الخازمي

لا أدري ما السبب في المشكلة التي تظهر لديك

قمت بتجربة الكود وتنفيذه أكثر من مرة ولا تحدث مشكلة خصوصاً أنني في الكود قد أضفت سطر في بداية الكود ونهايته لإلغاء الفلترة أي أن عملية الفلترة مؤقتة فقط لتعيين النطاق المراد إخفاء صفوفه .أي أن الفلترة وسيلة توصلنا للغاية المطلوبة

عموماً هناك كود الأخ الغالي رجب ويعمل بشكل سريع أيضاً ...

تقبل تحياتي

 

[رجب جاويش]

أخى ياسر

أخى محمد

جربت عندى كود أخى ياسر وهو يعمل بشكل ممتاز وسريع بدون أى مشاكل

 

[مهند الزيدي]

انا ايضا جربت الكود ولم تحدث معي اي مشكلة ...

شكرا أخي ياسر على الكود الإكثر من رائع ..

مع شكري للإستاذ رجب جاويش

[محمد الورفلي1]

ممكن من اصدار 2003