Soru Şarta Bağlı Otomatik Satır Gizleme ve Gösterme

Ömer BARAN

Uzman
Katılım
8 Mart 2011
Mesajlar
13,002
Excel Vers. ve Dili
Office 2013 ( 32 bit ) TÜRKÇE
Tekrar merhaba.

Varsa; şimdiye kadar verdiğim kodlardan, Modul veya ilgili sayfaların kod bölümüne eklediğiniz kodları silin.

VBA ekranında sol taraftaki VBA_Project alanında BuÇalışmaKitabı (ThisWorkbook) 'na fareyle çift tıklayıp,
aşağıdaki kod blokunu sağdaki boş alana yapıştırın. (ust adını verdiğim değişkene verilecek sayı, gizleme alanının üstünde kalan satır sayısıdır)

VERİ girişi sayfasında, diğer sayfalardaki formül sonuçlarını etkileyen değişiklik/ekleme/silme işlemleri yapın ve
ilgili sayfaya geçerek sonucu kontrol edin.
.
Rich (BB code):
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim sisim As String: Dim adres As Range: Dim alan As String

Application.ScreenUpdating = False
sisim = ActiveSheet.Name

If ActiveSheet.Name <> "PUANTAJ" And _
   ActiveSheet.Name <> "TOPLU BORDRO MAAŞ" And _
   ActiveSheet.Name <> "TOPLU BORDRO TEDİYE" Then Exit Sub

If ActiveSheet.Name = "PUANTAJ" Then: ust = 18: alan = "A19:A218"
If ActiveSheet.Name = "TOPLU BORDRO MAAŞ" Then: ust = 17: alan = "A18:A217"
If ActiveSheet.Name = "TOPLU BORDRO TEDİYE" Then: ust = 17: alan = "A18:A217"

ActiveSheet.Range(alan).EntireRow.Hidden = False
    a = ActiveSheet.Range(alan).Value
    For i = 1 To UBound(a)
        If a(i, 1) = 0 Or a(i, 1) = "" Then
            brn = brn + 1
            If brn = 1 Then: Set adres = Cells(i + ust, 1)
            If brn > 1 Then: Set adres = Union(adres, Cells(i + ust, 1))
        End If
    Next i
    If brn > 0 Then adres.EntireRow.Hidden = True
Application.ScreenUpdating = True
Erase a: Set adres = Nothing: sisim = Empty
alan = Empty: ust = Empty: brn = Empty: i = Empty
End Sub
 
Katılım
29 Mart 2013
Mesajlar
429
Excel Vers. ve Dili
Office 2016 Professional Türkçe 32 Bit
Ömer BARAN hocam Allah razı olsun istediğim oldu. Çok ilgilendiniz benimle. Ama inanın dua alıyorsunuz. Çünkü görme engelli olan ve çok az gören bir mutemet için hazırlıyorum bunu.
Fakat butona bağlayınca sadece ilk sırada yazılı PUANTAJ sayfasını gizliyor. Diğerler sayfalarda işe yaramadı. Nasıl bir düzenleme yapmam lazım.
Duruma göre buton ile de kullanmam lazım çünkü.
Buton ile belirtilen aralıklar gizlenirken, aynı zamanda;
PUANTAJ sayfasındaki A19:AU218 aralığındaki boş olan sütunlar ve
TOPLU BORDRO MAAŞ sayfasındaki A18:BZ217 aralığındaki boş olan sütunlar ve
TOPLU BORDRO TEDİYE sayfasındaki A18:BZ217 aralığındaki boş olan sütunları da gizlemek istiyorum.

Rich (BB code):
Private Sub CommandButton1_Click()
Dim sisim As String: Dim adres As Range: Dim alan As String

Application.ScreenUpdating = False
sisim = ActiveSheet.Name

If ActiveSheet.Name <> "PUANTAJ" And _
   ActiveSheet.Name <> "TOPLU BORDRO MAAŞ" And _
   ActiveSheet.Name <> "TOPLU BORDRO TEDİYE" Then Exit Sub

If ActiveSheet.Name = "PUANTAJ" Then: ust = 18: alan = "A19:A218"
If ActiveSheet.Name = "TOPLU BORDRO MAAŞ" Then: ust = 17: alan = "A18:A217"
If ActiveSheet.Name = "TOPLU BORDRO TEDİYE" Then: ust = 17: alan = "A18:A217"

ActiveSheet.Range(alan).EntireRow.Hidden = False
    a = ActiveSheet.Range(alan).Value
    For i = 1 To UBound(a)
        If a(i, 1) = 0 Or a(i, 1) = "" Then
            brn = brn + 1
            If brn = 1 Then: Set adres = Cells(i + ust, 1)
            If brn > 1 Then: Set adres = Union(adres, Cells(i + ust, 1))
        End If
    Next i
    If brn > 0 Then adres.EntireRow.Hidden = True
Application.ScreenUpdating = True
Erase a: Set adres = Nothing: sisim = Empty
alan = Empty: ust = Empty: brn = Empty: i = Empty
End Sub
 
Son düzenleme:
Katılım
29 Mart 2013
Mesajlar
429
Excel Vers. ve Dili
Office 2016 Professional Türkçe 32 Bit
Ömer Baran Hocam bakabilir misiniz bu duruma da ?
 

malitogan

Altın Üye
Katılım
10 Ocak 2009
Mesajlar
30
Excel Vers. ve Dili
2019
Alternatif,

Eğer verilerinize başlık satırı ekleme şansınız varsa ekteki dosyayı kullanabilirsiniz.

Kod Sayfa2 aktif olduğunda çalışacaktır. Böylece dosyanız daha performanslı çalışacaktır.
Korhan Hocam saygılar.
Güzel bir çalışma. Tam aradığım gibi. Benim dosyama uyguladım ancak çalıştıramadım. (Sayfa korumalı) Nerede hata yaptım acaba. Birde tüm A sütununu değil de E10:J23 aralığını (Birleştirilmiş hücreler var) sorgulasın ona göre satırları gizlesin istiyorum. Nasıl bir değişiklik yaparız makroda?
Teşekkür ederim.
 

Ekli dosyalar

malitogan

Altın Üye
Katılım
10 Ocak 2009
Mesajlar
30
Excel Vers. ve Dili
2019
Korhan Hocam saygılar.
Güzel bir çalışma. Tam aradığım gibi. Benim dosyama uyguladım ancak çalıştıramadım. (Sayfa korumalı) Nerede hata yaptım acaba. Birde tüm A sütununu değil de E10:J23 aralığını (Birleştirilmiş hücreler var) sorgulasın ona göre satırları gizlesin istiyorum. Nasıl bir değişiklik yaparız makroda?
Teşekkür ederim.
Bu kodla işimi şimdilik çözdüm.

Private Sub Worksheet_Activate()
Sheets("Yolluk Bildirim").Unprotect "****"
On Error Resume Next
ActiveSheet.ShowAllData
Range("E6:j23").AutoFilter 1, "<>0", 1, "<>"""""
Rows("44:1048576").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.EntireRow.Hidden = True
Range("E10").Select
Sheets("Yolluk Bildirim").Protect "****"
End Sub
 
Üst