Şartlı satır ve sütün gizleme

[drummers]

A2:AU2 aralığındaki satırlara veri girmekteyim

Sorum şudur:

1- A2 den başlamak üzere veri varsa satır aktif olacak yoksa diğer tüm satırlar gizlenecek.

2- AU sütunundan itibaren tüm sütunlar gizlenecek

Teşekkürler

 

[Korhan Ayhan]

Selamlar,

Kodun hangi durumda çalışacağını belirtmemişsiniz. Aşağıdaki kodu deneyiniz.

Option Explicit
 
Sub ŞARTLI_SATIR_SÜTUN_GİZLE()
    Application.ScreenUpdating = False
    With Cells
        .EntireRow.Hidden = False
        .EntireColumn.Hidden = False
    End With
 
    If Range("A2") = "" Then
    Range("A3:A65536").EntireRow.Hidden = True
    Else
    Range("A" & Range("A65536").End(3).Row + 1 & ":A65536").EntireRow.Hidden = True
    End If
    Columns("AV:IV").EntireColumn.Hidden = True
    Application.ScreenUpdating = True
End Sub

 

[drummers]

Selamlar,

Kodun hangi durumda çalışacağını belirtmemişsiniz. Aşağıdaki kodu deneyiniz.

Not: Profil bölümünüzde 2007 versiyon kullandığınızı belirtmişsiniz. Kodlar 2007 versiyon için düzenlenmiştir. Önceki versiyonlarda hata verecektir.

Option Explicit
 
Sub ŞARTLI_SATIR_SÜTUN_GİZLE()
    With Cells
        .EntireRow.Hidden = False
        .EntireColumn.Hidden = False
    End With
 
    If Range("A2") = "" Then
    Range("A2:A1048576").EntireRow.Hidden = True
    Else
    Range("A2:A" & Range("A1048576").End(3).Row).EntireRow.Hidden = True
    End If
    Columns("AV:XFD").EntireColumn.Hidden = True
End Sub

1- 2003 versiyonu için kullanılacak

2- A2 satırından başlıyarak AU2 ye kadar veri yazdığımı varsayalım, sadece A3 ten başlayan satır açık olacak ve A3 e veri girmeye başlarsam A4 açılacak

3- AV den başlıyan sütün IV ye kadar gizli olacak

ve açılışta otomatik çalışacak

Eksik bilgi için kusura bakmayın

Dosya eklenmiştir

 

[Korhan Ayhan]

Selamlar,

Bir önceki mesajımda If sorgusu bölümünde hata yapmışım. #2 nolu mesajımı yeniden düzenledim.

Son mesajınızdaki örnek dosyaya göre aşağıdaki kodları kullanabilirsiniz.

ThisWorkbook bölümüne;

Private Sub Workbook_Open()
    Application.ScreenUpdating = False
    Columns("AV:IV").Hidden = True
    Cells.EntireRow.Hidden = False
    If Range("A2") = "" Then
    Range("A3:A65536").EntireRow.Hidden = True
    Else
    Range("A" & Range("A65536").End(3).Row + 2 & ":A65536").EntireRow.Hidden = True
    End If
    Application.ScreenUpdating = True
End Sub

Sayfanın kod bölümüne;

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("A2:A65536")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Columns("AV:IV").Hidden = True
    Cells.EntireRow.Hidden = False
    If Range("A2") = "" Then
    Range("A3:A65536").EntireRow.Hidden = True
    Else
    Range("A" & Range("A65536").End(3).Row + 2 & ":A65536").EntireRow.Hidden = True
    End If
    Application.ScreenUpdating = True
End Sub

 

[drummers]

korhan bey dosyamda bir hata yaptım ve dosya açılmıyor
hatada şu: 2 tane otomatik makro çalıştırması ... donup kalıyor bir bakarsanız sevinirim. Yanda sorunu nasıl çözebilirim

 

[Korhan Ayhan]

Selamlar,

Dosyanızda 2 adet "Autpen" makrosu kullandığınız için kitlenme yaşıyorsunuz. İkinciyi silip içindeki kodu ilk "Autpen" kodlarının sonuna ekleyin.

 

[drummers]

dosyayı açamıyorum. donup kalıyor. Alt+F11 de çalışmıyor .. Ahhh bi açsa silecem de .

 

[Korhan Ayhan]

Selamlar,

Dosyanızı makroları etkinleştirmeden açın. Ancak bu şekilde silebilirsiniz.

 

[drummers]

Vallahi aklıma geleni yazdınız.. teşekkürler

 

[halit3]

alternatif olarak bütün excel dosyalarında çalışan kod
sayfanın kod bölümüne ekleyiniz

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim bas
Dim son
Dim baslangic
Dim bitis
Dim bas1
bas1 = Cells(Rows.Count, "a").End(3).Row
If Intersect(Target, Range("A" & bas1 & ":A" & bas1)) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
With Cells
.EntireRow.Hidden = False
.EntireColumn.Hidden = False
End With
bas = Cells(Rows.Count, "a").End(3).Row + 2
son = Rows.Count
Rows(bas & ":" & Rows.Count).EntireRow.Hidden = True
baslangic = Left(Columns(48).Address(0, 0), InStr(Columns(48).Address(0, 0), ":") - 1) 'AV sütunundan başlıyor
bitis = Left(Columns(Columns.Count).Address(0, 0), InStr(Columns(Columns.Count).Address(0, 0), ":") - 1)
Columns(baslangic & ":" & bitis).EntireColumn.Hidden = True
Application.ScreenUpdating = True
End Sub

 

[harhar]

Merhaba,

Satırlar ile beraber aynı şekilde sütünlar içinde gizleme ve gösterme işlemi yapılabilinirmi. Tablo genişlemesi veri girdikçe hem satır bazında hemde sütün bazında olabilirmi?

Şimdiden teşekkürler, İyi Çalışmalar.

 

[yıldız57]

iyi akşamlar üstadlarım;
ekteki dosyamda A sütununda ki değerlerden herhangi birini B3 hücresine girdiğimde arada kalan satırların veri girene kadar sayfa bölmesinin ilk satırına gelmesini istiyorum. girilen değer yalnız değişken olacak 1015 yazdığımda 1001 ile 1014 arası gizlenecek.

 

[Korhan Ayhan]

Selamlar,

Sayfanızın kod bölümüne aşağıdaki kodu uygulayıp denermisiniz. B3 hücresine değer girip deneyin.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim BUL As Range
    If Intersect(Target, Range("B3")) Is Nothing Then Exit Sub
    Cells.EntireRow.Hidden = False
    If Target <> "" Then
        Set BUL = Range("A:A").Find(Target, , , xlWhole)
        If Not BUL Is Nothing Then
            If BUL.Row > 7 Then
                Range("A7:A" & BUL.Row - 1).EntireRow.Hidden = True
            Else
                Range("A7:A" & BUL.Row).EntireRow.Hidden = True
            End If
        End If
        Set BUL = Nothing
    End If
End Sub

 

[yıldız57]

Korhan bey ilginize çok teşekkür ederim mükemmel olmuş elinize sağlık