حذف عمود بشرط

[jack305]

االسلام عليكم

اريد حذف الاعمدة  اوتوماتيكيا  و عودتها  اوتوماتيكيا بشرط  اذا كان    b7   في الورقة 3  يساوي 0   يحذف العمود   E 

M.xlsm

[محي الدين ابو البشر]

Hi jack305

حسب ما فهمت منك 

Sub test()
    Dim a, b As Variant
    Dim i As Long
    a = Array(Array("B"), Array("E"), Array("H"), Array("J"), Array("M"))
    b = Array(Array("E"), Array("H"), Array("K"), Array("N"), Array("Q"))
    With Sheet1
        For i = 0 To 4
            If Sheet2.Range(a(i)(0) & 7).Value = 0 Then 
                .Columns((b(i)(0))).EntireColumn.Hidden = True
            Else
                .Columns((b(i)(0))).EntireColumn.Hidden = False
            End If
        Next
    End With
End Sub

 

[jack305]

الكود لا يعمل

ما اريده  اخفاء  واظهار الاعمدة الملونة   ورقة    2اوتوماتيكيا  بشرط  من الورقة 1

b7=0  اذا كان   e اخفاء العمود  

اظهاره اوتوماتيكيا  اذا زال الشرط

e7=0  اذا كان  h اخفاء العمود  

اظهاره اوتوماتيكيا  اذا زال الشرط

h7=0 اذا كان   k اخفاء العمود  

اظهاره اوتوماتيكيا  اذا زال الشرط

j7=0  اذا كان   n اخفاء العمود  

اظهاره اوتوماتيكيا  اذا زال الشرط

m7=0  اذا كان   q اخفاء العمود  

اظهاره اوتوماتيكيا  اذا زال الشرط

M.xlsm

[محي الدين ابو البشر]

هكذا؟

M (1).xlsm

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

جرب هذا الكود

Option Explicit

Sub Hide_unhide()
Dim Sh1 As Worksheet, Sh2 As Worksheet
Dim Ar_cel, Ar_n, i%
Set Sh1 = Sheets("Sheet1"): Set Sh2 = Sheets("Sheet2")
Sh1.Range("d1:q1").EntireColumn.Hidden = False

Ar_cel = Array("B", "E", "H", "J", "N")
Ar_n = Array("E", "H", "k", "N", "Q")

For i = LBound(Ar_cel) To UBound(Ar_cel)
   Sh1.Range(Ar_n(i) & 1).EntireColumn.Hidden = _
   IIf(Sh2.Cells(7, Ar_cel(i)) = 0, -1, 0)
Next i
End Sub

Jack.xlsm

[jack305]

.... شكرا على الردود ....شكرا اخ سليم..... هل يمكن ان يشتغل  اوتوماتيكيا دون زر..  الكود يعمل  لكن اريده ان يشتغل اوتوماتيكيا

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

تم عمل المطلوب

Option Explicit

Sub Hide_unhide()
Dim Sh1 As Worksheet, Sh2 As Worksheet
Dim Ar_cel, Ar_n, i%
Application.ScreenUpdating = False
Set Sh1 = Sheets("Sheet1"): Set Sh2 = Sheets("Sheet2")
Sh1.Range("D1:Q1").EntireColumn.Hidden = False

Ar_cel = Array("B", "E", "H", "J", "N")
Ar_n = Array("E", "H", "k", "N", "Q")

For i = LBound(Ar_cel) To UBound(Ar_cel)
   Sh1.Range(Ar_n(i) & 1).EntireColumn.Hidden = _
   IIf(Sh2.Cells(7, Ar_cel(i)) = 0, -1, 0)
Next i
Application.ScreenUpdating = True

End Sub
'+++++++++++++++++++++++++++++++++++++++++

Private Sub Worksheet_Activate()
Hide_unhide
End Sub

Auto_Jack.xlsm

[jack305]

شكرا اخ سليم