• DİKKAT

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

koşullu satır gizleme

N

Nilay Karabasogullari

Katılım
12 Ekim 2017
Mesajlar
123
Excel Vers. ve Dili
2011
Merhaba Sayın Üyeler,

Kafama takıldı ama bir türlü başaramadım. çok kolay olduğuna eminim.

Sorum şu:
ekteki dosyada içindekiler diye bir yer var. Bu içindekilerden örnek olarak 1ini kaldırdım ve olmasını istediğim durumu da sheet 2 olarak ekledim excele.

yanı kırmızıları silince kırmızı kısım gitsin istiyorum, yesili silince yesil kısım vb.

içindekiler kısmından kaldırdığım kısmı, alttaki rapor kısmından da gizlenmek istiyorum. bir çeşit koşullu gizleme ama böyle birşey var mı nasıl yapılabilir bulamadım.

fikri olan veya yardım edebilecek birileri var mıdır?
 

Ekli dosyalar

Merhaba,

Çalışma sayfasının kod bölümüne kopyalayın.
Detaylı deneme yapmadım.

Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)

    Dim deg(), c As Range, son As Long, i As Byte
    Dim a As Byte, a1 As Long, a2 As Long
     
    If Intersect(Target, [B3,B5,B7,B9]) Is Nothing Then Exit Sub
     
    Cells.EntireRow.Hidden = False
    deg = Array("ev", "araba", "kagit", "cicek")
    son = Cells(Rows.Count, "A").End(xlUp).Row
     
    Application.ScreenUpdating = False
     
    For i = 3 To 9 Step 2
        If Cells(i, "B") = "" Then
            Set c = Range("A11:A" & son).Find(deg(a), , xlValues, xlWhole)
            If Not c Is Nothing Then
                a1 = c.Row
                a2 = Range("A" & a1).End(xlDown).Row
                Rows(a1 & ":" & a2).EntireRow.Hidden = True
            End If
        End If
        a = a + 1
    Next i
    
    Application.ScreenUpdating = True

End Sub


.
 
Merhaba sayin yetkili,oncelikle yardiminiz icin cok tesekkurler fakat gonderdiginiz macroyu tam anlamiyla uygulayabildigimi dusunmuyorum. Ayrica farkli dosyalara uygulanabilir olmadigi kanisindayim. Bunu bir bicimlendirmeyle macrosuz cozme imkanimiz var midir?
 
Farklı dosyadan kastınızı anlayamadım.

Uygulama;

B3,B5,B7,B9 hücrelerinde veri yoksa aşağıdaki tablodaki ilgili aralığı gizliyor, varsa gizlemiyor. Makro ilgili hücrelere işlem yaptığında tetikleyerek çalışır.

Satır gizleme işini sadece biçimlendirme kullanarak yapamazsınız. Koşullu biçimledirme ile yalnızca ilgili hücrelerin fontunu beyaz yaparak görünmez yapabilirsiniz.

.
 
Ömer' Alıntı:
Farklı dosyadan kastınızı anlayamadım.

Uygulama;

B3,B5,B7,B9 hücrelerinde veri yoksa aşağıdaki tablodaki ilgili aralığı gizliyor, varsa gizlemiyor. Makro ilgili hücrelere işlem yaptığında tetikleyerek çalışır.

Satır gizleme işini sadece biçimlendirme kullanarak yapamazsınız. Koşullu biçimledirme ile yalnızca ilgili hücrelerin fontunu beyaz yaparak görünmez yapabilirsiniz.

.
Genişletmek için tıkla ...

sayin yetkili, ekte dosyanizi gonderir misiniz? macro bende islemedi o yuzden istiyorum.
 
Ektedir.

.
 

Ekli dosyalar

Ömer' Alıntı:
Ektedir.

.
Genişletmek için tıkla ...

Cok tesekkurler sayin yetkili. Ufak bir sorum olacak.

B6da "Evet" yaziyorsa 30 ve 40. satir araligini gizlemek istiyorum,
"Hayir" yaziyorsa 40 ve 50. satir araligini gizlemek istiyorum.

seklinde bir macro nasil yazilabilir? Benim istedigim gibi uyarlayabilmem acisindan bunu yazmam cok faydali olacaktir.
 
Bu şekilde deneyin.

Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)

    Dim deg As String
     
    If Intersect(Target, [B6]) Is Nothing Then Exit Sub

    Application.ScreenUpdating = False
    Cells.EntireRow.Hidden = False
    
    deg = UCase(Replace(Replace(Target, "ı", "I"), "i", "İ"))

    If deg = "EVET" Then
        Rows("30:40").EntireRow.Hidden = True
    ElseIf deg = "HAYIR" Then
        Rows("40:50").EntireRow.Hidden = True
    End If
    
    Application.ScreenUpdating = True

End Sub


.
 
Elinize saglik Ömer Bey. Macronuz sorunsuz calismakta. Peki bir ileriye tasisam sorumu. Yani;
eger b6 evet ise
su satirlari gizle (bu kisim guzel calisiyor)

fakat c6 evet ise su satirlari da gizle, d6 evetse su satirlari da gizle seklinde bir sey yazmak mumkun mudur? Bu macroya eklemeyi denedim ben ama basaramadim pek bilmedigimden dolayi
 
Bu şekilde deneyin.

Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)

    Dim deg As String
     
    If Intersect(Target, [B6,C6,D6]) Is Nothing Then Exit Sub

    Application.ScreenUpdating = False
    If Target.Count > 1 Then Exit Sub

    deg = UCase(Replace(Replace(Target, "ı", "I"), "i", "İ"))

    If Target.Address(0, 0) = "B6" Then
        Rows("30:50").EntireRow.Hidden = False
        If deg = "EVET" Then
            Rows("30:40").EntireRow.Hidden = True
        ElseIf deg = "HAYIR" Then
            Rows("40:50").EntireRow.Hidden = True
        End If
    End If
    
    If Target.Address(0, 0) = "C6" Then
        Rows("10:30").EntireRow.Hidden = False
        If deg = "EVET" Then
            Rows("10:20").EntireRow.Hidden = True
        ElseIf deg = "HAYIR" Then
            Rows("20:30").EntireRow.Hidden = True
        End If
    End If
    
    If Target.Address(0, 0) = "D6" Then
        Rows("50:70").EntireRow.Hidden = False
        If deg = "EVET" Then
            Rows("50:60").EntireRow.Hidden = True
        ElseIf deg = "HAYIR" Then
            Rows("60:70").EntireRow.Hidden = True
        End If
    End If
    
    Application.ScreenUpdating = True

End Sub


Not: Mesaj içeriklerinin tümünde kalın font kullanmamanızı rica ederim. İnanın okurken göz yoruyor.

.
 
Merhaba Ömer Bey, teşekkür ederim düzeltmeniz için. Bir şey sormak istiyorum normalde B6, C6 ve D6 başka bir hücreden çekiyor ama bu yazdığınız makronun çalışması için illa B6, C6 ve D6'ya elle manuel olarak yazmam gerekiyor. Bunun bir çözümü var mıdır acaba veriyi başka yerden çektiğimde de bu makronun çalışmasını sağlayacak?
 
Bu şekilde deneyin.

Kod: 
Private Sub Worksheet_Calculate()

    Application.ScreenUpdating = False

    Rows("30:50").EntireRow.Hidden = False
    If UCase(Replace(Replace([B6], "ı", "I"), "i", "İ")) = "EVET" Then
        Rows("30:40").EntireRow.Hidden = True
    ElseIf UCase(Replace(Replace([B6], "ı", "I"), "i", "İ")) = "HAYIR" Then
        Rows("40:50").EntireRow.Hidden = True
    End If

    Rows("10:30").EntireRow.Hidden = False
    If UCase(Replace(Replace([C6], "ı", "I"), "i", "İ")) = "EVET" Then
        Rows("10:20").EntireRow.Hidden = True
    ElseIf UCase(Replace(Replace([C6], "ı", "I"), "i", "İ")) = "HAYIR" Then
        Rows("20:30").EntireRow.Hidden = True
    End If

    Rows("50:70").EntireRow.Hidden = False
    If UCase(Replace(Replace([D6], "ı", "I"), "i", "İ")) = "EVET" Then
        Rows("50:60").EntireRow.Hidden = True
    ElseIf UCase(Replace(Replace([D6], "ı", "I"), "i", "İ")) = "HAYIR" Then
        Rows("60:70").EntireRow.Hidden = True
    End If
    
    Application.ScreenUpdating = True

End Sub

.
 
Merhaba Ömer Bey, yapmak istediğim şeyi net olarak yazmam sanırım size daha az uğraş verdirmemi sağlayacaktır :)

Benim istediğim aslında tam olarak şu:

Eğer AE4 hücresinde "Erkek" yazıyorsa 371:407 ve 646:710 satırlarının gizlenmesini
Eğer AE4 hücresinde "Kadın" yazıyorsa 339:368 satırlarının gizlenmesini
ve eğer V473 hücresinde "Hayır" yazıyorsa 493:525 satırlarının gizlenmesini istiyorum. (not: AE4 ve V473'e veri başka bir sayfadan otomatik olarak geliyor, elle girmiyorum).

Yardımınız ve ilginiz için şimdiden teşekkür ederim.
 
Zaman kaybı olmaması için soru açıklamalarınızı ilk mesajda daha net yapmanızı rica ederim.

Kod: 
Private Sub Worksheet_Calculate()

    Application.ScreenUpdating = False

    Rows("339:368").EntireRow.Hidden = False
    Rows("371:407").EntireRow.Hidden = False
    Rows("646:710").EntireRow.Hidden = False
    If UCase(Replace(Replace([AE4], "ı", "I"), "i", "İ")) = "ERKEK" Then
        Rows("371:407").EntireRow.Hidden = True
        Rows("646:710").EntireRow.Hidden = True
    ElseIf UCase(Replace(Replace([AE4], "ı", "I"), "i", "İ")) = "KADIN" Then
        Rows("339:368").EntireRow.Hidden = True
    End If

    Rows("493:525").EntireRow.Hidden = False
    If UCase(Replace(Replace([V473], "ı", "I"), "i", "İ")) = "HAYIR" Then
        Rows("493:525").EntireRow.Hidden = True
    End If

    Application.ScreenUpdating = True

End Sub

.
 
Ömer' Alıntı:
Zaman kaybı olmaması için soru açıklamalarınızı ilk mesajda daha net yapmanızı rica ederim.

Kod: 
Private Sub Worksheet_Calculate()

    Application.ScreenUpdating = False

    Rows("339:368").EntireRow.Hidden = False
    Rows("371:407").EntireRow.Hidden = False
    Rows("646:710").EntireRow.Hidden = False
    If UCase(Replace(Replace([AE4], "ı", "I"), "i", "İ")) = "ERKEK" Then
        Rows("371:407").EntireRow.Hidden = True
        Rows("646:710").EntireRow.Hidden = True
    ElseIf UCase(Replace(Replace([AE4], "ı", "I"), "i", "İ")) = "KADIN" Then
        Rows("339:368").EntireRow.Hidden = True
    End If

    Rows("493:525").EntireRow.Hidden = False
    If UCase(Replace(Replace([V473], "ı", "I"), "i", "İ")) = "HAYIR" Then
        Rows("493:525").EntireRow.Hidden = True
    End If

    Application.ScreenUpdating = True

End Sub

.
Genişletmek için tıkla ...


Haklısınız, bundan sonra daha dikkatli olacağım bu konuda. Teşekkür ederim.
 
Ömer' Alıntı:
Zaman kaybı olmaması için soru açıklamalarınızı ilk mesajda daha net yapmanızı rica ederim.

Kod: 
Private Sub Worksheet_Calculate()

    Application.ScreenUpdating = False

    Rows("339:368").EntireRow.Hidden = False
    Rows("371:407").EntireRow.Hidden = False
    Rows("646:710").EntireRow.Hidden = False
    If UCase(Replace(Replace([AE4], "ı", "I"), "i", "İ")) = "ERKEK" Then
        Rows("371:407").EntireRow.Hidden = True
        Rows("646:710").EntireRow.Hidden = True
    ElseIf UCase(Replace(Replace([AE4], "ı", "I"), "i", "İ")) = "KADIN" Then
        Rows("339:368").EntireRow.Hidden = True
    End If

    Rows("493:525").EntireRow.Hidden = False
    If UCase(Replace(Replace([V473], "ı", "I"), "i", "İ")) = "HAYIR" Then
        Rows("493:525").EntireRow.Hidden = True
    End If

    Application.ScreenUpdating = True

End Sub

.
Genişletmek için tıkla ...


Ömer Bey merhabalar,

Tekrardan rahatsız ediyorum sizi. Yazmış olduğunuz formülü ben Sheet2 sayfasında kullanmayı hedefliyorum, Sheet2'deki AE4 ve V473'e veriler Sheet1'deki D6 ve G38 hücrelerinden geliyor.

Sheet1'e de başka bir Excel dosyasından kopyala yapıştır yapılması gerekiyor. Fakat başka bir Excel'den Sheet1'e kopyala yapıştır yaptığımda "Microsoft Excel çalışmayı durdurdu" hatası alıyorum ve kapanıyor. Neden olabileceğine dair bir fikriniz var mıdır acaba? Vereceğiniz her türlü cevap ve ayıracağınız vakit için şimdiden teşekkür ederim.

Saygılar
 
Sheet1 sayfasının kod bölümünde kullandığınız kod makro varmı?
 
Dosyanızı eklemeniz mümkün mü?
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst