Listeleme

[halilerol]

Iyi akşamlar arkadaşlar. Forumda varmı diye bakmaya çalıştım bulamadım.
Ekli belgede j3 te ne varsa o haftanın görüntülenmesini istiyorum yapabilir miyim?
Yardım ederseniz sevinirim

 

[Korhan Ayhan]

Selamlar,

Ekteki örnek dosyayı incelermisiniz. Makro ile hazırlanmıştır.

 

[halilerol]

sayın korhan bey ilginize teşekkür ederim. tam istediğim gibi.
yalnız bunu 40 hftaya yaymek istersem makroda nereleri değiştirmem gerek.
makrodan hiç anlamıyorum da kusura bakmayın

 

[Korhan Ayhan]

Selamlar,

Siz istediğiniz kadar yayabilirsiniz. Sadece satır aralıklarının aynı olmasına dikkat edin. Yani 1. HAFTA 20 satırı kapsıyorsa diğerleride aynı olursa kodda bir değişiklik yapmanıza gerek yok.

 

[halilerol]

çok teşekkür ederim hocam yaptım. iyi geceler diliyorum.

 

[halilerol]

Hocam tekrar rahatsız ediyorum ama dünki örneğin içine 2 sayfa daha ekelemek istersek kodu nasıl değiştirmemiz gerekir örnek ekte.

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu Sayfa1 in kod bölümüne uygulayıp denermisiniz.

Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim SAYFA As Worksheet, BUL As Range
    If Intersect(Target, [B1]) Is Nothing Then Exit Sub
    If Target = "" Then
        For Each SAYFA In Worksheets
            If SAYFA.Name <> "Sayfa1" Then SAYFA.Cells.EntireRow.Hidden = False
        Next
    Else
        For Each SAYFA In Worksheets
            If SAYFA.Name <> "Sayfa1" Then
                With SAYFA
                    .Cells.EntireRow.Hidden = False
                    Set BUL = .Range("C:C").Find(Target, LookAt:=xlWhole)
                    If Not BUL Is Nothing Then
                    If BUL.Row = 2 Then
                    .Rows("22:65536").EntireRow.Hidden = True
                    Else
                    .Rows("1:" & BUL.Row - 2).EntireRow.Hidden = True
                    .Rows("" & BUL.Row + 20 & ":65536").EntireRow.Hidden = True
                    End If
                    End If
                End With
            End If
        Next
        Set BUL = Nothing
    End If
End Sub

 

[halilerol]

ilginize teşekkür ederim. denedim çalışıyor.