Soru Satır gizleme

[zar]

Veri giriş sayasında A9:A39 satırlarında bilgiler mevcut, bu bilgiler sayfa1, sayfa2, sayfa3 e aynı hücre aralıklarına formül ile bilgiler aktarılıyor. Veri giriş sayfasında kaç adet satır doluysa diğer 3 sayfaya da A9:A39 arasındaki satır sayısı da o kadar olsun. Geri kalan satırlar gizlensin istiyorum. Yardım için tşkler şimdiden.

 

[zar]

Cvp alamayacam herhalde. ?

 

[Korhan Ayhan]

Merhaba,

Veri girişi yaptığınız sayfanızın kod bölümüne uygulayıp deneyiniz. Bu sayfada A9:A39 aralığına veri girişi yaptıkça kod çalışacaktır.

Gerekiyorsa kod içinde geçen sayfa isimlerini düzenlersiniz..

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Rng As Range, Check_Rng As Range, Sh As Variant

    If Intersect(Target, Range("A9:A39")) Is Nothing Then Exit Sub
   
    For Each Rng In Range("A9:A39")
        If Rng = "" Then
            If Check_Rng Is Nothing Then
                Set Check_Rng = Rng
            Else
                Set Check_Rng = Union(Check_Rng, Rng)
            End If
        End If
    Next
       
    If Not Check_Rng Is Nothing Then
        For Each Sh In Array("Sayfa1", "Sayfa2", "Sayfa3")
            Sheets(Sh).Cells.EntireRow.Hidden = False
            Sheets(Sh).Range(Check_Rng.Address).EntireRow.Hidden = True
        Next
    End If
End Sub

 

[zar]

Korhan bey cevabınız için tşkler fakat ben bir konuda yanlış bilgi aktardım.
Sayfa1 a9:a39
Sayfa2 b5:b35
Sayfa3 b7:b37 olacak bu kodu düzenleyemedim. Ltfn kusura bakmayın, yardımınız içim çok tşkler şimdiden.

 

[Korhan Ayhan]

Veri giriş sayasında A9:A39 satırlarında bilgiler mevcut, bu bilgiler sayfa1, sayfa2, sayfa3 e aynı hücre aralıklarına formül ile bilgiler aktarılıyor. Veri giriş sayfasında kaç adet satır doluysa diğer 3 sayfaya da A9:A39 arasındaki satır sayısı da o kadar olsun. Geri kalan satırlar gizlensin istiyorum. Yardım için tşkler şimdiden.

 

[veyselemre]

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Rng As Range, rw%, sh, dif, sy

    If Intersect(Target, Range("A9:A39")) Is Nothing Then Exit Sub
    For Each Rng In Range("A9:A39")
        If Rng.Value = "" Then
            rw = Rng.Row
            Exit For
        End If
    Next
    If rw > 0 Then
        dif = Array(0, 4, 2)
        sy = 0
        For Each sh In Array("Sayfa1", "Sayfa2", "Sayfa3")
            With Sheets(sh)
                .Cells.EntireRow.Hidden = False
                .Rows(rw - dif(sy) & ":" & 39 - dif(sy)).Hidden = True
            End With
            sy = sy + 1
        Next sh
    End If
End Sub