• DİKKAT

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

Yazıya göre sütun gizlemek

ihsan hocam gerçekten bilmiyordum çok özür diliyorum bilsem yazarmıydım öğrendiğim iyi oldu
benim konuyu bir çözü verebilirmisiniz
 
iyi günler şöyle bir mantık doğru olurmu bilmiyorum
b sütununda
alış yazınca f,g,h,p,q,r,s,t,u, sütunlarını gizlese c,d,e,ı,j,k,l,m,n,o,v, sütunlarını gösterse
gider yazınca k,l,m,n,o, sütunlarını gizlese c,d,e,f,g,h,ı,j,p,q,r,s,t,u,v, sütunlarını gösterse
satış yazınca e,p,q,r,s,t,u, sütunlarını gizlese c,d,f,g,h,ı,j,k,l,m,n,o,v, sütunlarını gösterse
gelir yazınca e,k,l,m,n,o, sütunlarını gizlese c,d,f,g,h,ı,j,p,q,r,s,t,u,v, sütunlarını gösterse
bununla beraber
c sütununa kırtasiye yazmıyorsa s,t,u, sütunlarını gizlese diğer sütunları gösterse


tablo aralığı b:v aralığıdır
bu şekilde olsa olurmu biryardımcı olabilirmisiniz
 
Merhaba,

Sayfanızın kod bölümüne aşağıdaki kodu uygulayıp denermisiniz.

Kod:
Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Veri As String
    If Intersect(Target, Range("B:C")) Is Nothing Then Exit Sub
    
    Veri = UCase(Replace(Replace(Cells(Target.Row, "B"), "i", "İ"), "ı", "I"))
    Range("B:V").EntireColumn.Hidden = False
    Select Case Veri
        Case Is = "ALIŞ"
            Range("F:H,P:P,Q:U").EntireColumn.Hidden = True
        Case Is = "GİDER"
            Range("K:O").EntireColumn.Hidden = True
        Case Is = "SATIŞ"
            Range("E:E,P:U").EntireColumn.Hidden = True
        Case Is = "GELİR"
            Range("E:E,K:O").EntireColumn.Hidden = True
    End Select
    
    If Veri = "GELİR" Or Veri = "GİDER" And UCase(Replace(Replace(Cells(Target.Row, "C"), "i", "İ"), "ı", "I")) = "KIRTASİYE" Then
        Range("S:U").EntireColumn.Hidden = True
    Else
        Range("S:U").EntireColumn.Hidden = False
    End If
End Sub
 
korhan hocam ilginiz için teşekkür ederim b sütunundaki işlemler istediğimi yapıyor ancak gelir ve gider yazınca c sütunda kırtasiye varsa stu sütunları görünse kırtasiyeden başka bir şey yazıyorsa stu sütunlarını gizlese
 
Merhaba,

Üstteki mesajımdaki kodu güncelledim. Denermisiniz.
 
ilginiz için teşekkür ederim
alış yazınca stu sütunlarını gizlemiyor
satış yazınca stu sütunlarını gizlemiyor
gelir yazınca fazlalık olarak stu sütunlarını gizliyor

gider yazınca ve c sütununa kırtasiye veya başka bir şey yazınca doğru diğerlerinde yanlış yapıyor
 
Merhaba,

Birde aşağıdaki şekilde denermisiniz.

Kod:
Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Veri As String
    If Intersect(Target, Range("B:C")) Is Nothing Then Exit Sub
    
    Veri = UCase(Replace(Replace(Cells(Target.Row, "B"), "i", "İ"), "ı", "I"))
    Range("B:V").EntireColumn.Hidden = False
    Select Case Veri
        Case Is = "ALIŞ"
            Range("F:H,P:P,Q:U").EntireColumn.Hidden = True
        Case Is = "GİDER"
            Range("K:O").EntireColumn.Hidden = True
        Case Is = "SATIŞ"
            Range("E:E,P:U").EntireColumn.Hidden = True
        Case Is = "GELİR"
            Range("E:E,K:O").EntireColumn.Hidden = True
    End Select
    
    If (Veri = "GELİR" Or Veri = "GİDER") And UCase(Replace(Replace(Cells(Target.Row, "C"), "i", "İ"), "ı", "I")) = "KIRTASİYE" Then
        Range("S:U").EntireColumn.Hidden = False
    Else
        Range("S:U").EntireColumn.Hidden = True
    End If
End Sub
 
korhan bey ilginiz için teşekkür ederim isteiğim oldu işimi görüyor
 
iyi günler yeni dosya ekledim yapılması gerekn işlem a5 şe yazılan işleme göre gizlemesi daha önceki kırtasiye işlemi aynı mantıkla b sütünuna yazılınca olacak

alış :e:g,o:aa
gider : j:q,t:w kırtasiye yazınca göstereceği y:aa
satış :e:e,l:n,r:aa
gelir :e:e,j:q,x:aa kırtasiye yazınca göstereceği u:w
 

Ekli dosyalar

Merhaba,

Aşağıdaki kodu denermisiniz.

Kod:
Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Veri As String
    If Intersect(Target, Range("A5,B6:B" & Rows.Count)) Is Nothing Then Exit Sub
    
    Veri = UCase(Replace(Replace(Range("A5"), "i", "İ"), "ı", "I"))
    Range("B:AB").EntireColumn.Hidden = False
    Select Case Veri
        Case Is = "ALIŞ"
            Range("E:G,O:AA").EntireColumn.Hidden = True
        Case Is = "GİDER"
            Range("J:Q,T:W").EntireColumn.Hidden = True
        Case Is = "SATIŞ"
            Range("E:E,L:N,R:AA").EntireColumn.Hidden = True
        Case Is = "GELİR"
            Range("E:E,J:Q,X:AA").EntireColumn.Hidden = True
    End Select
    
    If Veri = "GİDER" And UCase(Replace(Replace(Cells(Target.Row, "B"), "i", "İ"), "ı", "I")) = "KIRTASİYE" Then
        Range("Y:AA").EntireColumn.Hidden = False
    Else
        Range("Y:AA").EntireColumn.Hidden = True
    End If
    
    If Veri = "GELİR" And UCase(Replace(Replace(Cells(Target.Row, "B"), "i", "İ"), "ı", "I")) = "KIRTASİYE" Then
        Range("U:W").EntireColumn.Hidden = False
    Else
        Range("U:W").EntireColumn.Hidden = True
    End If
End Sub
 
iyi günler 32. mesaj daki koda ila yapmak istiyorum
kodun altında eğer gelir ve gider ise "b" sütunu kırtasiye ise diye bir mantık ve buraya ilave olarak yine aynı gelir ve giderde "s" sütunu çek ise örenek t:y arasını gibi mantık ileva etmek isritoyum yardımcı olabilirmisiniz
 
korhan hocam iyi günler bu konada bana yardımcı olabilirmisiniz
alttaki koda ikinçi bir mantık eklemek eğer s sütunu çek ise t:y arasını gizlese gibi aynı mantıkda
 
Merhaba,

Aşağıdaki kod bloğunu ekleyip deneyin.

Kod:
[FONT=Verdana][SIZE=2]If Veri = "GELİR" And _
UCase(Replace(Replace(Cells(Target.Row, "B"), "i", "İ"), "ı", "I")) = "KIRTASİYE" And _
UCase(Cells(Target.Row, "S")) = "ÇEK" Then
    Range("T:Y").EntireColumn.Hidden = False
Else
    Range("T:Y").EntireColumn.Hidden = True
End If[/SIZE][/FONT][FONT=Verdana][SIZE=2]
[/SIZE][/FONT]
 
If Veri = "GİDER" And UCase(Replace(Replace(Cells(Target.Row, "B"), "i", "İ"), "ı", "I")) = "KIRTASİYE" Then
Range("Y:AA").EntireColumn.Hidden = False
Else
Range("Y:AA").EntireColumn.Hidden = True
End If

If Veri = "GELİR" And UCase(Replace(Replace(Cells(Target.Row, "B"), "i", "İ"), "ı", "I")) = "KIRTASİYE" Then
Range("U:W").EntireColumn.Hidden = False
Else
Range("U:W").EntireColumn.Hidden = True
End If


hocam ilginiz için teşkkür ederim bu kod işlemi aynı duracak buna ilave olarak aynı gelir ve giderde "S" stununda çek varsa t:y arasını bu şekilde ilave etmek istiyorum yani önceki "B" sütunuda kırtasiye varsa y:aa bunu yine yapacak bununla beraber s de çek varsa t:y yapmak istiyorum
 
Merhaba,

Ben zaten önerdiğim kodu ekleyin deneyin dedim. Eskilerini silin demedim.

END SUB satırından öncesine verdiğim kodu ekleyip deneyin.
 
ilginiz için teşekkür ederim ekledim ancak olmadı sadece gelir de işlem yapıyor b ye kırtasiye yazınca hem daha öncekini hemde t:y arasını gösteriyor

istediğim önceki kod aynı şekilde ilemi yapacak
yeni olması gereken gelir ve giderde s sütununda çek varsa t:y arasını
b sütunun da kırtasiye ile bağlantılı değil ancak önce dediğim gibi b de ki önceki mantık yine olacak
 
Merhaba,

Aşağıdaki şekilde denermisiniz.

Kod:
Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Veri As String
    If Intersect(Target, Range("A5,B6:B65536,S6:S65536")) Is Nothing Then Exit Sub
    
    Veri = UCase(Replace(Replace(Range("A5"), "i", "İ"), "ı", "I"))
    Range("B:AB").EntireColumn.Hidden = False
    Select Case Veri
        Case Is = "ALIŞ"
            Range("E:G,O:AA").EntireColumn.Hidden = True
        Case Is = "GİDER"
            Range("J:Q,T:W").EntireColumn.Hidden = True
        Case Is = "SATIŞ"
            Range("E:E,L:N,R:AA").EntireColumn.Hidden = True
        Case Is = "GELİR"
            Range("E:E,J:Q,X:AA").EntireColumn.Hidden = True
    End Select
    
    If Veri = "GİDER" And UCase(Replace(Replace(Cells(Target.Row, "B"), "i", "İ"), "ı", "I")) = "KIRTASİYE" Then
        Range("Y:AA").EntireColumn.Hidden = False
    Else
        Range("Y:AA").EntireColumn.Hidden = True
    End If
    
    If Veri = "GELİR" And UCase(Replace(Replace(Cells(Target.Row, "B"), "i", "İ"), "ı", "I")) = "KIRTASİYE" Then
        Range("U:W").EntireColumn.Hidden = False
    Else
        Range("U:W").EntireColumn.Hidden = True
    End If
    If (Veri = "GELİR" Or Veri = "GİDER") And UCase(Cells(Target.Row, "S")) = "ÇEK" Then
        Range("T:Y").EntireColumn.Hidden = False
    Else
        Range("T:Y").EntireColumn.Hidden = True
    End If
End Sub
 
korhan hocam ilginiz için teşekkür ederim tam istediğim gibi
 
Geri
Üst