Tarih Kriterine ve Satır Değerine Göre Sütun Gizleme

[cavanoos]

Merhaba;

Ekteki örnek dosyamda B1 hücresine girdiğim tarih değerine göre;

a) 7. satırdan itibaren sadece ilgili tarih satırı kalmalı
b) Sütun olarak da seçili tarihte EVET yazısı olmayan sütunlar kalmalı

Bu işlem sonucunda ilgili dosyada;

a) 7. ve 20. satırlar gizlenecek ve 22. satır ile 100. satır arası gizlenmiş olacak.
b) B, E, F, H, J ve K sütunları gizlenmiş olacak.

Yardımcı olabilir misiniz ?

 

[ÖmerBey]

Merhaba,
Yanlış dosyayı yüklemiş olabilir misiniz?

 

[cavanoos]

Evet, yanlış dosya, tekrar yükledim.

 

[ÖmerBey]

b) Sütun olarak da seçili tarihte EVET yazısı olmayan sütunlar kalmalı

b) B, E, F, H, J ve K sütunları gizlenmiş olacak.

B seçenekleri birbirinin zıddı gibi hangisi gizlenecek Evet yazan mı, yazmayan mı?

 

[cavanoos]

Ömer Bey;

İlk defa bir konuda bu kadar fazla saçmaladım. Önce hatalı dosya, şimdi de bu. Özür dilerim.

Evet yazan sütun gizlenecek

 

[ÖmerBey]

Aşağıdaki kodu ilgili sayfanın kod bölümüne kopyalayınız.
Ancak B sütununda EVET yazdığı durumda tarih girdiğiniz hücre de gizlenecektir.
Bilginize...

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("B1")) Is Nothing Then
    If Range("B1") = "" Then
        With Range("B7:K100")
            .EntireColumn.Hidden = False
            .EntireRow.Hidden = False
        End With
    Else
        Dim trh As Date
        Dim a As Byte, b As Byte
        trh = Range("B1").Value
        Application.ScreenUpdating = False
        With Range("B7:K100")
            .EntireColumn.Hidden = True
            .EntireRow.Hidden = True
        End With
        For a = 7 To 100
            If Cells(a, "A").Value Like trh Then
                Cells(a, "A").EntireRow.Hidden = False
                For b = 1 To 10
                    If Cells(a, b) <> "EVET" Then
                        Cells(a, b).EntireColumn.Hidden = False
                    End If
                Next
            End If
        Next
        Application.ScreenUpdating = True
    End If
End If
End Sub

 

[cavanoos]

Elinize sağlık, süper olmuş