• DİKKAT

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

Koşula göre farklı sayfalardaki satırları gizleme ve gösterme

Katılım
2 Ekim 2015
Mesajlar
74
Excel Vers. ve Dili
2019 TR
Merhabalar arkadaşlar bir konuda yardıma ihtiyacım var sorunum şu şekilde;

Sayfa 1 deki A1 hücresi eğer "Öğretmen" ise Sayfa 1 deki 3. ve 7. satırları Sayfa 2 deki 4. ve 8. satırları Sayfa 3 teki 2. ve 6. satırları otomatik gizlensin
Sayfa 1 deki A1 hücresi eğer
"Öğrenci" ise Sayfa 1 deki 5. ve 11. satırları Sayfa 2 deki 3. ve 6. satırları Sayfa 3 teki 2.ve 6. satırları otomatik gizlensin
Sayfa 1 deki A1 hücresi
Boş ise Sayfa 1, Sayfa 2, Sayfa 3 te hiçbir satırı gizlemesin

Sayfa 1 kod bölümüne bunu yazdım ama diğer sayfalardakileri ekleyemedim
KOD:
Private Sub Worksheet_Change(ByVal Target As Range)

If Range("A1") = "Öğretmen" Then
Rows("3:7").EntireRow.Hidden = True
Rows("9:9").EntireRow.Hidden = True

ElseIf Range("A1") = "Öğrenci" Then
Rows("3:3").EntireRow.Hidden = False
Rows("7:7").EntireRow.Hidden = False
Rows("5:5").EntireRow.Hidden = True
Rows("11:11").EntireRow.Hidden = True

Else
Rows("3:11").EntireRow.Hidden = False

End If

End Sub
 
Merhaba , kodlara şu şekilde ekleme yaparak yapabilirsiniz..

Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
    If Range("A1") = "Öğretmen" Then
        Rows("3:7").EntireRow.Hidden = True
        Rows("9:9").EntireRow.Hidden = True
        Sheets("Sayfa2").Rows("3:7").EntireRow.Hidden = True
        Sheets("Sayfa2").Rows("9:9").EntireRow.Hidden = True
        Sheets("Sayfa3").Rows("3:7").EntireRow.Hidden = True
        Sheets("Sayfa3").Rows("9:9").EntireRow.Hidden = True
    ElseIf Range("A1") = "Öğrenci" Then
        Rows("3:3").EntireRow.Hidden = False
        Rows("7:7").EntireRow.Hidden = False
        Rows("5:5").EntireRow.Hidden = True
        Rows("11:11").EntireRow.Hidden = True
        Sheets("Sayfa2").Rows("3:3").EntireRow.Hidden = False
        Sheets("Sayfa2").Rows("7:7").EntireRow.Hidden = False
        Sheets("Sayfa2").Rows("5:5").EntireRow.Hidden = True
        Sheets("Sayfa2").Rows("11:11").EntireRow.Hidden = True
        Sheets("Sayfa3").Rows("3:3").EntireRow.Hidden = False
        Sheets("Sayfa3").Rows("7:7").EntireRow.Hidden = False
        Sheets("Sayfa3").Rows("5:5").EntireRow.Hidden = True
        Sheets("Sayfa3").Rows("11:11").EntireRow.Hidden = True
    Else
        Rows("3:11").EntireRow.Hidden = False
        Sheets("Sayfa2").Rows("3:11").EntireRow.Hidden = False
        Sheets("Sayfa3").Rows("3:11").EntireRow.Hidden = False
    End If
End Sub

Yada alternatif olarak bu şekilde de kullanabilirsiniz , daha kısa..

Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
    If Range("A1") = "Öğretmen" Then
        Range("3:7,9:9").EntireRow.Hidden = True
        Sheets("Sayfa2").Range("3:7,9:9").EntireRow.Hidden = True
        Sheets("Sayfa3").Range("3:7,9:9").EntireRow.Hidden = True
    ElseIf Range("A1") = "Öğrenci" Then
        Range("3:3,5:5,7:7,11:11").EntireRow.Hidden = True
        Sheets("Sayfa2").Range("3:3,5:5,7:7,11:11").EntireRow.Hidden = True
        Sheets("Sayfa3").Range("3:3,5:5,7:7,11:11").EntireRow.Hidden = True
    Else
        Rows("3:11").EntireRow.Hidden = False
        Sheets("Sayfa2").Rows("3:11").EntireRow.Hidden = False
        Sheets("Sayfa3").Rows("3:11").EntireRow.Hidden = False
    End If
End Sub
 
Merhaba.

Aşağıdaki kodları kullanabilirsiniz. Alternatif olsun.
Kod:
Option Compare Text

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("A1")) Is Nothing Then
        Rows.EntireRow.Hidden = False
        Worksheets("Sayfa2").Rows.EntireRow.Hidden = False
        Worksheets("Sayfa3").Rows.EntireRow.Hidden = False
        If Range("A1") = "Öğretmen" Then
            Range("3:3, 7:7").EntireRow.Hidden = True
            Worksheets("Sayfa2").Range("4:4, 8:8").EntireRow.Hidden = True
            Worksheets("Sayfa3").Range("2:2, 6:6").EntireRow.Hidden = True
        ElseIf Range("A1") = "Öğrenci" Then
            Range("5:5, 11:11").EntireRow.Hidden = True
            Worksheets("Sayfa2").Range("3:3, 6:6").EntireRow.Hidden = True
            Worksheets("Sayfa3").Range("2:2, 6:6").EntireRow.Hidden = True
        End If
    End If
End Sub
 
Hepinize ayrı ayrı çok teşekkür ederim dünden beri uğraşıyordum bir türlü yapamamıştım
 
Rica ederiz , iyi çalışmalar. :)
 
dediklerinizi yaptım işlem sıkıntısız çalışıyor fakat yeni bir problem ortaya çıktı. şöyle ki çalışma sayfamda korumam gereken formüllerin olduğu hücreler var onları sayfa koruma yaptığımda makro hatası alıyorum (hata kodu:1004 Range sınıfının hidden özelliği kurulamıyor)
gizlemeye çalıştığım hücreler G 2 : AK 6 aralığında
yazmış olduğum kod aşağıdaki gibidir yardımlarınızı bekliyorum

Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False

If Range("E8") = "Okul Müdürü" Then
Rows("8:8").EntireRow.Hidden = False
Rows("9:9").EntireRow.Hidden = False
Rows("10:10").EntireRow.Hidden = True
Sheets("AYRINTILI DÖKÜM").Rows("5:5").EntireRow.Hidden = True
Sheets("AYRINTILI DÖKÜM").Rows("6:6").EntireRow.Hidden = False
Sheets("AYRINTILI DÖKÜM").Rows("7:7").EntireRow.Hidden = True
Sheets("AYRINTILI DÖKÜM").Rows("8:8").EntireRow.Hidden = False
ElseIf Range("E8") = "Okul Öncesi Öğretmeni" Then
Rows("8:8").EntireRow.Hidden = False
Rows("9:9").EntireRow.Hidden = True
Rows("10:10").EntireRow.Hidden = False
Sheets("AYRINTILI DÖKÜM").Rows("5:5").EntireRow.Hidden = False
Sheets("AYRINTILI DÖKÜM").Rows("6:6").EntireRow.Hidden = False
Sheets("AYRINTILI DÖKÜM").Rows("7:7").EntireRow.Hidden = False
Sheets("AYRINTILI DÖKÜM").Rows("8:8").EntireRow.Hidden = True
Else
Rows("8:10").EntireRow.Hidden = False
Sheets("AYRINTILI DÖKÜM").Rows("5:5").EntireRow.Hidden = True
Sheets("AYRINTILI DÖKÜM").Rows("6:6").EntireRow.Hidden = False
Sheets("AYRINTILI DÖKÜM").Rows("7:7").EntireRow.Hidden = False
Sheets("AYRINTILI DÖKÜM").Rows("8:8").EntireRow.Hidden = False
End If
End Sub
 
Merhaba , kodların başına sayfa korumasını kaldıracak sonuna da tekrar koruyacak kodları ekleyiniz..

Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False

ActiveSheet.Unprotect
Sheets("AYRINTILI DÖKÜM").Unprotect


If Range("E8") = "Okul Müdürü" Then
Rows("8:8").EntireRow.Hidden = False
Rows("9:9").EntireRow.Hidden = False
Rows("10:10").EntireRow.Hidden = True
Sheets("AYRINTILI DÖKÜM").Rows("5:5").EntireRow.Hidden = True
Sheets("AYRINTILI DÖKÜM").Rows("6:6").EntireRow.Hidden = False
Sheets("AYRINTILI DÖKÜM").Rows("7:7").EntireRow.Hidden = True
Sheets("AYRINTILI DÖKÜM").Rows("8:8").EntireRow.Hidden = False
ElseIf Range("E8") = "Okul Öncesi Öğretmeni" Then
Rows("8:8").EntireRow.Hidden = False
Rows("9:9").EntireRow.Hidden = True
Rows("10:10").EntireRow.Hidden = False
Sheets("AYRINTILI DÖKÜM").Rows("5:5").EntireRow.Hidden = False
Sheets("AYRINTILI DÖKÜM").Rows("6:6").EntireRow.Hidden = False
Sheets("AYRINTILI DÖKÜM").Rows("7:7").EntireRow.Hidden = False
Sheets("AYRINTILI DÖKÜM").Rows("8:8").EntireRow.Hidden = True
Else
Rows("8:10").EntireRow.Hidden = False
Sheets("AYRINTILI DÖKÜM").Rows("5:5").EntireRow.Hidden = True
Sheets("AYRINTILI DÖKÜM").Rows("6:6").EntireRow.Hidden = False
Sheets("AYRINTILI DÖKÜM").Rows("7:7").EntireRow.Hidden = False
Sheets("AYRINTILI DÖKÜM").Rows("8:8").EntireRow.Hidden = False
End If


ActiveSheet.Protect
Sheets("AYRINTILI DÖKÜM").Protect

End Sub
 
teşekkür ederim emre bey valla boşuna dememişler hiç bilenle bilmeyen bir olur mu diye :) k.bakmayın tekrar tekrar rahatsızlık veriyorum son bir sorum daha olacaktı yukarıdaki koda ilave olarak şöyle bir komut verdirmek mümkün müdür ?
eğer aktif sayfadaki B8 hücresinde herhangi bir değer yok ise aynı sayfadaki 10-11-12. satırları gizle eğer B8 de herhangi bir değer var ise 10-11-12. satırları göster (verdiğim rahatsızlık için hakkınızı helal edin)
 
Şu kodları ekleyerek yapabilirsiniz.
Kod:
If Range("B8") = "" Then
    Range("10:12").EntireRow.Hidden = True
Else
    Range("10:12").EntireRow.Hidden = False
End If
 
Geri
Üst