Koşula Göre Sütun Gizleme ve Gösterme Yardımı

[Believing]

Sayın Uzman Arkadaşlar,

Sitedeki örneklerden maalesef düşündüğümü hayata geçiremedim. Önrek çalışmada da görüleceği üzere D;ND sütun aralığında günlük kayıtı tutulan minibar kullanımını gösteren tablo bulunmaktadır. A1 hücresinde ise aylık seçim yapılabilmektedir. A1 hücresinde hangi ay seçilmişse, o ay dışında kalan tüm tablo sütunlarının gizelenmesi, A1'den başka bir ay seçildiğinde ise seçime ait sütunların gösterilmesini sağlanacaktır.
Siz uzman arkadaşları çok değerli yardımlarını rica ediyorum.
Saygılarımla.

Link:
http://www.dosya.tc/server9/l1rodh/ORNEK_MINIBAR_TASARIM.rar.html

 

[Ömer]

Merhaba,

İki değiştiriciye de bu kodu atayarak deneyin.

Sub Sutun_Gizle()

    Dim Wf As WorksheetFunction
    Dim a As Double, b As Integer, c As Double, d As Integer
    
    Set Wf = WorksheetFunction
    
    Application.ScreenUpdating = False
    Columns("D:ND").EntireColumn.Hidden = False
    
    a = CDate("1." & [a1] & "." & [B1])
    b = Wf.Match(a, Rows(3), 0)
    c = DateSerial(Year(a), Month(a) + 1, 0)
    d = Wf.Match(c, Rows(3), 0) + 1
    
    If b = 4 Then
        Range(Columns(d), Columns(368)).EntireColumn.Hidden = True
        Exit Sub
    End If
    
    Range(Columns(4), Columns(b - 1)).EntireColumn.Hidden = True
    Range(Columns(d), Columns(369)).EntireColumn.Hidden = True
    
    Application.ScreenUpdating = True

End Sub

.

 

[Believing]

Sayın Ömer bey,

Makroları değiştiricilere atadım ama herhangi bir sütun gizlemedi, ben mi yanlış yapıyorum acaba?

Saygılarımla,

 

[Ömer]

Ektedir.

.

 

[Believing]

Sayın Ömer bey,

Özür dilerim, sorun benim değiştiriclere kodu gerektiği gibi atayamamdan kaynaklanmaktadır. Çok değerli yardımınız içiz size çok teşekkür.
İçinde bulunduğum mübarek Cuma gününün sizin ve sevdikleriniz için hayırlara vesile olmasını dilerim.

Saygılarımla.

 

[Ömer]

Sorun değil, işinize yaradığına sevindim.

İyi çalışmalar.

 

[Omerullah]

Sayın Ömer bey,
Aynı çalışmaya sayfa koruması koyduğumuzda kodların çaılşmasını nasıl sağlayabiliriz.
Saygılarımla.

 

[Ömer]

Merhaba,

İlaveler kırmızı ile işaretli.
İşlemi yapmadan önce değiştiricilere sağ klik yapın ve denetim biçimlendirmeden koruma seçeneklerindeki işaretleri kaldırın.

Sub Sutun_Gizle()

    Dim Wf As WorksheetFunction
    Dim a As Double, b As Integer, c As Double, d As Integer
    
    Set Wf = WorksheetFunction
    
    Application.ScreenUpdating = False
    
[COLOR="red"]    ActiveSheet.Unprotect "şifreniz"
    Range("A2").Locked = False[/COLOR]

    Columns("D:ND").EntireColumn.Hidden = False
    
    a = CDate("1." & [a1] & "." & [B1])
    b = Wf.Match(a, Rows(3), 0)
    c = DateSerial(Year(a), Month(a) + 1, 0)
    d = Wf.Match(c, Rows(3), 0) + 1
    
    If b = 4 Then
        Range(Columns(d), Columns(368)).EntireColumn.Hidden = True
        Exit Sub
    End If
    
    Range(Columns(4), Columns(b - 1)).EntireColumn.Hidden = True
    Range(Columns(d), Columns(369)).EntireColumn.Hidden = True
    
[COLOR="red"]    ActiveSheet.Protect DrawingObjects:=True, Password:="şifreniz"[/COLOR]
    Application.ScreenUpdating = True

End Sub

.

 

[Believing]

Sayın Ömer bey,
Benim için çok değerli yardımınız için size çok, çok teşekkür ederim.
ALLAH sizden razı olsun.
Saygılarımla.