• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Otomatik Satır Gizleme-Gösterme

P

piton7

Katılım
22 Ağustos 2012
Mesajlar
39
Excel Vers. ve Dili
2000 türkçe
http://www.dosyayukleyin.com/do.php?id=5441]Piton12345.xlsx

Linkde verdiğim dosyada "-" olan satırların otomatik gizlenmesini,değer geldiğinde tekrar satırları otomatik göstermesini istiyorum.dosyada daha ayrıntılı yazdım.basit bişe gibi ama beceremedim.çözümleriniz için şimdiden teşekkür ederim.
 
Son düzenleme:
Valla indirdimde hala aynı.tek fark bi stop işareti ile gülen surat gördüm o kadar Onları da anlamadım zaten :)
 
. . .

Tablo bu kadar mı.
18-19. satırları mı gizle/göster yapılacak.

. . .
 
Stop basınca istediğin gibi " - " işaretini görürse gizliyor.
Gülen yüz basınca gösteriyor.

Fakat Dosyayı açınca makroları etkinleştir butonuna basmanız gerekiyor.
 
piton7' Alıntı:
http://www.dosyayukleyin.com/do.php?id=5441]Piton12345.xlsx

Linkde verdiğim dosyada "-" olan satırların otomatik gizlenmesini,değer geldiğinde tekrar satırları otomatik göstermesini istiyorum.dosyada daha ayrıntılı yazdım.basit bişe gibi ama beceremedim.çözümleriniz için şimdiden teşekkür ederim.
Genişletmek için tıkla ...
Merhaba.

Alt taraftan sayfa adına fareyle sağ tıklayın, göreceğiniz seçeneklerden KOD GÖRÜNTÜLEyi seçin,
açılan ekranın sağ tarafındaki boş alana aşağıdaki kod'u yapıştırın.

Dikkat: Kodları yapıştırınca;
-- "-" işaretleri ardışık satırlarda ise mavi satırları silin,(bu şekilde daha hızlı sonuç alırsınız)
-- "-" işaretleri aralıklı da olabiliyorsa kırmızı satırları silin.
Verilerin miktarına göre kodlarda herhangi bir değişiklik gerekmez.
B2 hücresindeki değeri değiştirerek sonucu gözlemleyin.
.
Kod: 
[FONT="Arial Narrow"][B]Private Sub Worksheet_Change(ByVal Target As Range)[/B]
If Intersect(Target, [B2]) Is Nothing Then Exit Sub
Rows.Hidden = False
[COLOR="Blue"]For satır = [A65536].End(3).Row To 13 Step -1
    If Cells(satır, 1).Value = "-" Then
        Rows(satır & ":" & satır).EntireRow.Hidden = True
    End If
Next[/COLOR]
[COLOR="Red"]    adet = WorksheetFunction.CountIf(Range("A:A"), "-")
    ilk = WorksheetFunction.Match("-", Range("A:A"), 0)
Rows(ilk & ":" & adet + ilk - 1).EntireRow.Hidden = True[/COLOR]
[B]End Sub[/B][/FONT]
 
Son düzenleme:
. . .

Aşağıdaki kodları Protokol sayfasının kod bölümüne yapıştırın.

Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo hata
    
    If Target.Address(0, 0) <> "B2" Then Exit Sub
    Application.ScreenUpdating = False
    sonsat = Evaluate("=LOOKUP(2,1/(Sayfa3!$A$1:$A$65536<>""""),ROW(Sayfa3!$A$1:$A$65536))")
    Sheets("Sayfa3").Rows("13:" & sonsat).EntireRow.Hidden = False
    
    For i = 13 To sonsat
        If Sheets("Sayfa3").Cells(i, "A") = "-" Then
            Sheets("Sayfa3").Rows(i).EntireRow.Hidden = True
        End If
    Next i
    
hata:
    Application.ScreenUpdating = True
End Sub

. . .
 
Birde şöyle bişe için bi kod istesem.
Mesela yine bi kodla sayfada A15 hücresinden itibaren aşağı doğru ne kadar "-" işareti varsa gizliycek.
A15den yukarda olan bütün "-" işaretleri kalacak.
 
Son düzenleme:
. . .

Kod: 
Sub kod()
    Dim S As Worksheet: Set S = Sheets("Sayfa3")
    sonsat = Evaluate("=LOOKUP(2,1/(Sayfa3!$A$1:$A$65536<>""""),ROW(Sayfa3!$A$1:$A$65536))")
    Application.ScreenUpdating = False
    S.Rows("1:" & sonsat).EntireRow.Hidden = False
    For i = 15 To sonsat
        If S.Cells(i, "A") = "-" Then
            S.Rows(i).EntireRow.Hidden = True
        End If
    Next i
    Application.ScreenUpdating = True
End Sub

. . .
 
çok hızlı oldu.teşekkür ederim :)
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst