هل ممكن إخفاء الصفوف والأعمدة بالأكواد؟

[حماده سعد الله]

السادة الأفاضل السلام عليكم ورحمة الله وبركاته

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

كما بالصورة

2016-02-27_202603.rar

تم تعديل فبراير 27, 2016 بواسطه حماده سعد الله

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

جرب هذا الكود

Sub DeleteEmptyRowsAndColumns()
        x = ActiveSheet.UsedRange.Row - 1
        y = ActiveSheet.UsedRange.Rows.Count
        LastRow = x + y
Application.ScreenUpdating = False

    For r = LastRow To 1 Step -1
        If Application.CountA(Rows(r)) = 0 Then Rows(r).Delete
    Next r
        m = ActiveSheet.UsedRange.Column - 1
        n = ActiveSheet.UsedRange.Columns.Count
        LastColumn = m + n

    For c = LastColumn To 1 Step -1
        If Application.CountA(Columns(c)) = 0 Then Columns(c).Delete
    Next c
Application.ScreenUpdating = True
End Sub

 

[حماده سعد الله]

شكرا أخي سليم ولكن يبدو أنني  لم أتمكن من ايضاح ما طلبت 

أنا لم أطلب الحذف بل طلبت الاخفاء

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

تم التعديل حسب الطلب

Sub HideEmptyRowsAndColumns()
 UsedRange.Rows.Hidden = False
 UsedRange.Columns.Hidden = False
        x = ActiveSheet.UsedRange.Row - 1
        y = ActiveSheet.UsedRange.Rows.Count
        LastRow = x + y
Application.ScreenUpdating = False

    For r = LastRow To 1 Step -1
        If Application.CountA(Rows(r)) = 0 Then Rows(r).Hidden = True
    Next r
        m = ActiveSheet.UsedRange.Column - 1
        n = ActiveSheet.UsedRange.Columns.Count
        LastColumn = m + n

    For c = LastColumn To 1 Step -1
        If Application.CountA(Columns(c)) = 0 Then Columns(c).Hidden = True
    Next c
Application.ScreenUpdating = True
End Sub

 

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

جرب الكود التالي عله يفي بالغرض

Sub HideEmptyRowsAndColumns()
    Dim X As Long, LR As Long
    
    With Application
        .ScreenUpdating = False
            Columns.Hidden = False: Columns.Hidden = True

            For X = 1 To Columns.Count
                If .WorksheetFunction.CountA(Columns(X)) > 0 Then Columns(X).Hidden = False
            Next X
            
            LR = Cells.SpecialCells(xlCellTypeLastCell).Row
            Rows(LR + 1 & ":" & Rows.Count).Hidden = True
            
            For X = 1 To LR
                If .WorksheetFunction.CountA(Rows(X)) = 0 Then Rows(X).Hidden = True
            Next X
            
            Application.Goto Range("A1"), True
        .ScreenUpdating = True
    End With
End Sub

 

[حماده سعد الله]

شكراً جزيلاً أستاذ ياسر بارك الله لك في عملك وجعله في ميزان حسناتك كما أشكر الأستاذ سليم ولكم مني فائق الإحترام

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

أخي العزيز حماده سعد الله

بارك الله فيك وجزيت خيراً على دعائك الطيب ..

 

الحمد لله أن تم المطلوب على خير .. والحمد لله الذي بنعمته تتم الصالحات