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

Katılım
8 Mart 2011
Mesajlar
12,387
Beğeniler
475
Excel Vers. ve Dili
Office 2013 ( 32 bit ) TÜRKÇE
#21
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
390
Beğeniler
1
Excel Vers. ve Dili
Office 2016 Professional Türkçe 32 Bit
#22
Ö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
390
Beğeniler
1
Excel Vers. ve Dili
Office 2016 Professional Türkçe 32 Bit
#24
Ömer Baran Hocam bakabilir misiniz bu duruma da ?
 
Üst