makro ile filitreleme yapmak

gedavet · 9 Ocak 2012

iyi çalışmalar
ekdeki dosyada yapmak istediğim a4 hücresindeki yazıya göre ilgili sütundaki filitreden boş olanlar kutucuğundan işareti kladırmasını istiyorum

a4 de alış yazıyorsa önce filitreleri temizlemesi sonra alış tutarı yani 14. sütundaki filitreden boş olanlar dan işareti kaldırması

a4 de satış yazıyorsa önce filitreleri temizlemesi sonra satış tutarı yani 17. sütundaki filitreden boş olanlar dan işareti kaldırması

a4 de gelir yazıyorsa önce filitreleri temizlemesi sonra gelir yani 26. sütundaki filitreden boş olanlar dan işareti kaldırması

a4 de gider yazıyorsa önce filitreleri temizlemesi sonra gider yani 30. sütundaki filitreden boş olanlar dan işareti kaldırması

Emir Hüseyin Çoban · 9 Ocak 2012

. . .

Makro kaydet ile biraz denemeler yapın.
Daha sonra kodları sadeleştirelim.

. . .

gedavet · 9 Ocak 2012

Sub Makro1()
'
' Makro1 Makro
'

'
Range("A4").Select
ActiveSheet.ShowAllData
ActiveSheet.Range("$B$4:$AI$13").AutoFilter Field:=13, Criteria1:="<>"
Range("O4").Select
ActiveSheet.ShowAllData
ActiveSheet.Range("$B$4:$AI$13").AutoFilter Field:=16, Criteria1:="<>"
Range("Z4").Select
ActiveSheet.ShowAllData
ActiveSheet.Range("$B$4:$AI$13").AutoFilter Field:=25, Criteria1:="<>"
Range("AD4").Select
ActiveSheet.ShowAllData
ActiveSheet.Range("$B$4:$AI$13").AutoFilter Field:=29, Criteria1:="<>"
End Sub

hocam ilginiz için teşekkür ederim bu şekilde bir örnek verdi

Emir Hüseyin Çoban · 9 Ocak 2012

. . .

Boş bir modüle aşağıdaki kodları uygulayın.

Kod:

Sub kod_alış()
On Error Resume Next
    ActiveSheet.ShowAllData
    Sheets("CARİ").Range("$B$4:$AI$65536").AutoFilter Field:=13, Criteria1:="<>"
End Sub


Sub kod_satış()
On Error Resume Next
    ActiveSheet.ShowAllData
    Sheets("CARİ").Range("$B$4:$AI$65536").AutoFilter Field:=16, Criteria1:="<>"
End Sub

Sub kod_gelir()
On Error Resume Next
    ActiveSheet.ShowAllData
    Sheets("CARİ").Range("$B$4:$AI$65536").AutoFilter Field:=25, Criteria1:="<>"
End Sub

Sub kod_gider()
On Error Resume Next
    ActiveSheet.ShowAllData
    Sheets("CARİ").Range("$B$4:$AI$65536").AutoFilter Field:=29, Criteria1:="<>"
End Sub

Cari sayfasının kod bölümündeki kodlara ilave yaptım. Aşağıdaki kodları uygulayın.

Kod:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim S1 As Worksheet, S2 As Worksheet, BUL As Range, Adres As String
    
    On Error Resume Next
    Dim sat As Integer

''''''''''''''''''''''''''''''''''''''''''''HARF DÜZENLEMESİ'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    
If Target.Column = 2 Or Target.Column = 4 Or Target.Column = 5 Or Target.Column = 6 Or Target.Column = 9 Or Target.Column = 10 Or Target.Column = 11 Or Target.Column = 18 Or Target.Column = 19 Or Target.Column = 20 Or Target.Column = 21 Or Target.Column = 25 Then
On Error Resume Next
Application.EnableEvents = False
Target.Value = UCase(Replace(Replace(Target.Value, "ı", "I"), "i", "İ"))
Application.EnableEvents = True
Else
End If

If Target.Column = 7 Or Target.Column = 8 Or Target.Column = 22 Or Target.Column = 23 Then
Dim i As Integer, deg, deg2 As String
On Error Resume Next
Application.EnableEvents = False
Target.Value = WorksheetFunction.Proper(Target.Value)
deg = Split(Target.Value, " ")
For i = LBound(deg) To UBound(deg) - 1
deg2 = deg2 & " " & deg(i)
Next
Target.Value = deg2 & " " & UCase(Replace(Replace(deg(UBound(deg)), "ı", "I"), "i", "İ"))
Target.Value = Right(Target.Value, Len(Target.Value) - 1)
Application.EnableEvents = True
End If
''''''''''''''''''''''''''''''''''''''''''''ÜRÜN BİRİM FİYATI BULMA'''''''''''''''''''''''''''''''''''''''''''''''''''''
On Error Resume Next
If Not Intersect(Target, Range("K5:K1048576")) Is Nothing Then
If Target = "" Then Exit Sub
If WorksheetFunction.CountIf(Sheets("ÜRÜNLER").Range("D:D"), Cells(Target.Row, "K")) > 0 Then
Cells(Target.Row, "P") = WorksheetFunction.VLookup(Cells(Target.Row, "K"), Sheets("ÜRÜNLER").Range("D:F"), 3, 0)
Else
Cells(Target.Row, "K") = ""
MsgBox " YAZDIĞINIZ ÜRÜN BULUNAMADI ", vbCritical, " DİKKAT !!!!! "
End If
End If

'''''''''''''''''''''''''''''''''''''''''''''''''''ALIŞ HESABI''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    If Target.Column = 12 Or Target.Column = 13 Then
        sat = Target.Row
        Cells(sat, "N") = Cells(sat, "L") * Cells(sat, "M")
    End If
'''''''''''''''''''''''''''''''''''''''''''''''''''SATIŞ HESABI''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    If Target.Column = 15 Or Target.Column = 16 Then
        sat = Target.Row
        Cells(sat, "Q") = Cells(sat, "O") * Cells(sat, "P")
    End If
'''''''''''''''''''''''''''''''''''''''''''''''''''GELİR HESABI''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    If Target.Column = 26 Or Target.Column = 27 Then
        Cells(Target.Row, "AB") = WorksheetFunction.Round(Cells(Target.Row, "AA") * Cells(Target.Row, "Z"), 2) / 100
        Cells(Target.Row, "AC") = WorksheetFunction.Round(Cells(Target.Row, "AB") + Cells(Target.Row, "Z"), 2)
    End If
'''''''''''''''''''''''''''''''''''''''''''''''''''GİDER HESABI''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    If Target.Column = 30 Or Target.Column = 31 Then
        Cells(Target.Row, "AF") = WorksheetFunction.Round(Cells(Target.Row, "AE") * Cells(Target.Row, "AD"), 2) / 100
        Cells(Target.Row, "AG") = WorksheetFunction.Round(Cells(Target.Row, "AF") + Cells(Target.Row, "AD"), 2)
    End If


'''''''''''''''''''''''''''''''''''''''''''''''''''GİZLE GÖSTER''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Dim Veri As String
    If Intersect(Target, Range("A4,B5:B65536,S5:S65536")) Is Nothing Then Exit Sub
    ActiveSheet.ShowAllData
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Veri = UCase(Replace(Replace(Range("A4"), "i", "İ"), "ı", "I"))
    Range("B:AI").EntireColumn.Hidden = False
    Select Case Veri
        Case Is = "ALIŞ"
            Range("E:G,O:AG,AJ:AK").EntireColumn.Hidden = True
            Call kod_alış
            
        Case Is = "GİDER"
            Range("J:Q,T:AC,AJ:AK").EntireColumn.Hidden = True
            Call kod_gider
        
        Case Is = "SATIŞ"
            Range("D:D,L:N,R:AG,AJ:AK").EntireColumn.Hidden = True
            Call kod_satış
            
        Case Is = "GELİR"
            Range("D:D,J:Q,T:Y,AD:AG,AJ:AK").EntireColumn.Hidden = True
            Call kod_gelir
            
    End Select
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    If Veri = "GİDER" And UCase(Replace(Replace(Cells(Target.Row, "B"), "i", "İ"), "ı", "I")) = "TAKVİM" Then
        Range("AE:AG").EntireColumn.Hidden = False
    Else
        Range("AE:AG").EntireColumn.Hidden = True
    End If
    If Veri = "GELİR" And UCase(Replace(Replace(Cells(Target.Row, "B"), "i", "İ"), "ı", "I")) = "TAKVİM" Then
        Range("AA:AC").EntireColumn.Hidden = False
    Else
        Range("AA:AC").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
    
'''''''''''''''''''''''''''''''''''''''''''''''''Satı Gizle'''''''''''''''''''''''''''''''''''''''''''''''''




End Sub

gedavet · 9 Ocak 2012

hüseyin bey ilginiz için teşekkür ederim
cari sayfa 2010 excele göre ekle menüsündeki tablo yu kullanıyorum onun için filitrelemeyi yapmıyor tablodan çıkarırsam yapıyor tabloya göre yayabilirmi

Emir Hüseyin Çoban · 9 Ocak 2012

. . .

Örnek dosyanıza göre yaptım.
Birde tablo halinin örneğini oluşturun. Üzerinde çalışalım.

. . .

gedavet · 9 Ocak 2012

hocam ekdeki dosyaya tablo uyguladım

Emir Hüseyin Çoban · 9 Ocak 2012

. . .

Boş bir modüle

Kod:

Sub kod_alış()
On Error Resume Next
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=13
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=13, Criteria1:="<>"
End Sub


Sub kod_satış()
On Error Resume Next
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=16
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=16, Criteria1:="<>"
End Sub

Sub kod_gelir()
On Error Resume Next
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=25
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=25, Criteria1:="<>"
End Sub

Sub kod_gider()
On Error Resume Next
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=29
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=29, Criteria1:="<>"
End Sub

Cari sayfasının kod bölümüne

Kod:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
    Dim S1 As Worksheet, S2 As Worksheet, BUL As Range, Adres As String
    
    On Error Resume Next
    Dim sat As Integer

'''''''''''''''''''''''''''''''''''''''''HARF DÜZENLEMESİ'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    
If Target.Column = 2 Or Target.Column = 4 Or Target.Column = 5 Or Target.Column = 6 Or Target.Column = 9 Or Target.Column = 10 Or Target.Column = 11 Or Target.Column = 18 Or Target.Column = 19 Or Target.Column = 20 Or Target.Column = 21 Or Target.Column = 25 Then
On Error Resume Next
Application.EnableEvents = False
Target.Value = UCase(Replace(Replace(Target.Value, "ı", "I"), "i", "İ"))
Application.EnableEvents = True
Else
End If

If Target.Column = 7 Or Target.Column = 8 Or Target.Column = 22 Or Target.Column = 23 Then
Dim i As Integer, deg, deg2 As String
On Error Resume Next
Application.EnableEvents = False
Target.Value = WorksheetFunction.Proper(Target.Value)
deg = Split(Target.Value, " ")
For i = LBound(deg) To UBound(deg) - 1
deg2 = deg2 & " " & deg(i)
Next
Target.Value = deg2 & " " & UCase(Replace(Replace(deg(UBound(deg)), "ı", "I"), "i", "İ"))
Target.Value = Right(Target.Value, Len(Target.Value) - 1)
Application.EnableEvents = True
End If
'''''''''''''''''''''''''''''''''''''''''ÜRÜN BİRİM FİYATI BULMA'''''''''''''''''''''''''''''''''''''''''''''''''''''
On Error Resume Next
If Not Intersect(Target, Range("K5:K1048576")) Is Nothing Then
If Target = "" Then Exit Sub
If WorksheetFunction.CountIf(Sheets("ÜRÜNLER").Range("D:D"), Cells(Target.Row, "K")) > 0 Then
Cells(Target.Row, "P") = WorksheetFunction.VLookup(Cells(Target.Row, "K"), Sheets("ÜRÜNLER").Range("D:F"), 3, 0)
Else
Cells(Target.Row, "K") = ""
MsgBox " YAZDIĞINIZ ÜRÜN BULUNAMADI ", vbCritical, " DİKKAT !!!!! "
End If
End If

''''''''''''''''''''''''''''''''''''''''''''''''ALIŞ HESABI''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    If Target.Column = 12 Or Target.Column = 13 Then
        sat = Target.Row
        Cells(sat, "N") = Cells(sat, "L") * Cells(sat, "M")
    End If
''''''''''''''''''''''''''''''''''''''''''''''''SATIŞ HESABI''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    If Target.Column = 15 Or Target.Column = 16 Then
        sat = Target.Row
        Cells(sat, "Q") = Cells(sat, "O") * Cells(sat, "P")
    End If
''''''''''''''''''''''''''''''''''''''''''''''''GELİR HESABI''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    If Target.Column = 26 Or Target.Column = 27 Then
        Cells(Target.Row, "AB") = WorksheetFunction.Round(Cells(Target.Row, "AA") * Cells(Target.Row, "Z"), 2) / 100
        Cells(Target.Row, "AC") = WorksheetFunction.Round(Cells(Target.Row, "AB") + Cells(Target.Row, "Z"), 2)
    End If
''''''''''''''''''''''''''''''''''''''''''''''''GİDER HESABI''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    If Target.Column = 30 Or Target.Column = 31 Then
        Cells(Target.Row, "AF") = WorksheetFunction.Round(Cells(Target.Row, "AE") * Cells(Target.Row, "AD"), 2) / 100
        Cells(Target.Row, "AG") = WorksheetFunction.Round(Cells(Target.Row, "AF") + Cells(Target.Row, "AD"), 2)
    End If


''''''''''''''''''''''''''''''''''''''''''''''''GİZLE GÖSTER''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Dim Veri As String
    If Intersect(Target, Range("A4,B5:B65536,S5:S65536")) Is Nothing Then Exit Sub
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=13
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=16
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=25
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=29
    
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Veri = UCase(Replace(Replace(Range("A4"), "i", "İ"), "ı", "I"))
    Range("B:AI").EntireColumn.Hidden = False
    Select Case Veri
        Case Is = "ALIŞ"
            Range("E:G,O:AG,AJ:AK").EntireColumn.Hidden = True
            Call kod_alış
            
        Case Is = "GİDER"
            Range("J:Q,T:AC,AJ:AK").EntireColumn.Hidden = True
            Call kod_gider
        
        Case Is = "SATIŞ"
            Range("D:D,L:N,R:AG,AJ:AK").EntireColumn.Hidden = True
            Call kod_satış
            
        Case Is = "GELİR"
            Range("D:D,J:Q,T:Y,AD:AG,AJ:AK").EntireColumn.Hidden = True
            Call kod_gelir
            
    End Select

    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    If Veri = "GİDER" And UCase(Replace(Replace(Cells(Target.Row, "B"), "i", "İ"), "ı", "I")) = "TAKVİM" Then
        Range("AE:AG").EntireColumn.Hidden = False
    Else
        Range("AE:AG").EntireColumn.Hidden = True
    End If
    If Veri = "GELİR" And UCase(Replace(Replace(Cells(Target.Row, "B"), "i", "İ"), "ı", "I")) = "TAKVİM" Then
        Range("AA:AC").EntireColumn.Hidden = False
    Else
        Range("AA:AC").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
    
''''''''''''''''''''''''''''''''''''''''''''''Satı Gizle'''''''''''''''''''''''''''''''''''''''''''''''''
Application.ScreenUpdating = true
End Sub

. . .

gedavet · 9 Ocak 2012

ilginiz için çok teşekkür ederim

gedavet · 10 Ocak 2012

hüseyin bey tablonın başka bir sütununda filitrede filitreleme varsa onu kaldırmıyor a4 de bir veri yazınca bütün filitreleri temizleyip ondan sonra ilgili filitrelemeyi yapsa

Emir Hüseyin Çoban · 10 Ocak 2012

. . .

Kod:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
    Dim S1 As Worksheet, S2 As Worksheet, BUL As Range, Adres As String
    
    On Error Resume Next
    Dim sat As Integer

'''''''''''''''''''''''''''''''''''''''''HARF DÜZENLEMESİ'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    
If Target.Column = 2 Or Target.Column = 4 Or Target.Column = 5 Or Target.Column = 6 Or Target.Column = 9 Or Target.Column = 10 Or Target.Column = 11 Or Target.Column = 18 Or Target.Column = 19 Or Target.Column = 20 Or Target.Column = 21 Or Target.Column = 25 Then
On Error Resume Next
Application.EnableEvents = False
Target.Value = UCase(Replace(Replace(Target.Value, "ı", "I"), "i", "İ"))
Application.EnableEvents = True
Else
End If

If Target.Column = 7 Or Target.Column = 8 Or Target.Column = 22 Or Target.Column = 23 Then
Dim i As Integer, deg, deg2 As String
On Error Resume Next
Application.EnableEvents = False
Target.Value = WorksheetFunction.Proper(Target.Value)
deg = Split(Target.Value, " ")
For i = LBound(deg) To UBound(deg) - 1
deg2 = deg2 & " " & deg(i)
Next
Target.Value = deg2 & " " & UCase(Replace(Replace(deg(UBound(deg)), "ı", "I"), "i", "İ"))
Target.Value = Right(Target.Value, Len(Target.Value) - 1)
Application.EnableEvents = True
End If
'''''''''''''''''''''''''''''''''''''''''ÜRÜN BİRİM FİYATI BULMA'''''''''''''''''''''''''''''''''''''''''''''''''''''
On Error Resume Next
If Not Intersect(Target, Range("K5:K1048576")) Is Nothing Then
If Target = "" Then Exit Sub
If WorksheetFunction.CountIf(Sheets("ÜRÜNLER").Range("D:D"), Cells(Target.Row, "K")) > 0 Then
Cells(Target.Row, "P") = WorksheetFunction.VLookup(Cells(Target.Row, "K"), Sheets("ÜRÜNLER").Range("D:F"), 3, 0)
Else
Cells(Target.Row, "K") = ""
MsgBox " YAZDIĞINIZ ÜRÜN BULUNAMADI ", vbCritical, " DİKKAT !!!!! "
End If
End If

''''''''''''''''''''''''''''''''''''''''''''''''ALIŞ HESABI''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    If Target.Column = 12 Or Target.Column = 13 Then
        sat = Target.Row
        Cells(sat, "N") = Cells(sat, "L") * Cells(sat, "M")
    End If
''''''''''''''''''''''''''''''''''''''''''''''''SATIŞ HESABI''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    If Target.Column = 15 Or Target.Column = 16 Then
        sat = Target.Row
        Cells(sat, "Q") = Cells(sat, "O") * Cells(sat, "P")
    End If
''''''''''''''''''''''''''''''''''''''''''''''''GELİR HESABI''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    If Target.Column = 26 Or Target.Column = 27 Then
        Cells(Target.Row, "AB") = WorksheetFunction.Round(Cells(Target.Row, "AA") * Cells(Target.Row, "Z"), 2) / 100
        Cells(Target.Row, "AC") = WorksheetFunction.Round(Cells(Target.Row, "AB") + Cells(Target.Row, "Z"), 2)
    End If
''''''''''''''''''''''''''''''''''''''''''''''''GİDER HESABI''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    If Target.Column = 30 Or Target.Column = 31 Then
        Cells(Target.Row, "AF") = WorksheetFunction.Round(Cells(Target.Row, "AE") * Cells(Target.Row, "AD"), 2) / 100
        Cells(Target.Row, "AG") = WorksheetFunction.Round(Cells(Target.Row, "AF") + Cells(Target.Row, "AD"), 2)
    End If


''''''''''''''''''''''''''''''''''''''''''''''''GİZLE GÖSTER''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Dim Veri As String
    If Intersect(Target, Range("A4,B5:B65536,S5:S65536")) Is Nothing Then Exit Sub

[COLOR="Red"]Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=1
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=2
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=3
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=4
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=5
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=6
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=7
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=8
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=9
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=10
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=11
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=12
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=13
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=14
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=15
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=16
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=17
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=18
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=19
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=20
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=21
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=22
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=23
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=24
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=25
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=26
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=27
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=28
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=29
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=30
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=31
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=32
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=33
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=34
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=35
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=36[/COLOR]
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Veri = UCase(Replace(Replace(Range("A4"), "i", "İ"), "ı", "I"))
    Range("B:AI").EntireColumn.Hidden = False
    Select Case Veri
        Case Is = "ALIŞ"
            Range("E:G,O:AG,AJ:AK").EntireColumn.Hidden = True
            Call kod_alış
            
        Case Is = "GİDER"
            Range("J:Q,T:AC,AJ:AK").EntireColumn.Hidden = True
            Call kod_gider
        
        Case Is = "SATIŞ"
            Range("D:D,L:N,R:AG,AJ:AK").EntireColumn.Hidden = True
            Call kod_satış
            
        Case Is = "GELİR"
            Range("D:D,J:Q,T:Y,AD:AG,AJ:AK").EntireColumn.Hidden = True
            Call kod_gelir
            
    End Select

    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    If Veri = "GİDER" And UCase(Replace(Replace(Cells(Target.Row, "B"), "i", "İ"), "ı", "I")) = "TAKVİM" Then
        Range("AE:AG").EntireColumn.Hidden = False
    Else
        Range("AE:AG").EntireColumn.Hidden = True
    End If
    If Veri = "GELİR" And UCase(Replace(Replace(Cells(Target.Row, "B"), "i", "İ"), "ı", "I")) = "TAKVİM" Then
        Range("AA:AC").EntireColumn.Hidden = False
    Else
        Range("AA:AC").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
    
''''''''''''''''''''''''''''''''''''''''''''''Satı Gizle'''''''''''''''''''''''''''''''''''''''''''''''''
Application.ScreenUpdating = True
End Sub

. . .

gedavet · 10 Ocak 2012

hüseyin bey kusura bakmayın sizide hemen uğraştırdım şimdi bu kodlar tablonun her hangi bir satıra veri yazınca çalışıyor en alsa bir satıra veri yazınca çalışıyor ondan sonrada o satır hemen kayboluyor diğer sütunları boş olduğu için
bundan dolayo bu kodlar a4 hücresine veri yazınca çalışsa diğer zaman çalışmasa

gedavet · 10 Ocak 2012

hüseyin hocam cari sayfasında bir kod olsa a4 hücresine veri yazınca çalışsa
ne yazarsam önce bütün filitreleri temizlese
sonra alış yazınca alış tutarı, satış yazınca satış tutarı, gelir yazınca gelir, gider yazınca gider,sütunlarındaki boş olanlar dan işareti kaldırsa bu şekilde olabilrimi
emeğiniz için çok teşekkür ederim

Emir Hüseyin Çoban · 10 Ocak 2012

. . .

Deneyiniz.

Kod:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
    Dim S1 As Worksheet, S2 As Worksheet, BUL As Range, Adres As String
    
    On Error Resume Next
    Dim sat As Integer

'''''''''''''''''''''''''''''''''''''''''HARF DÜZENLEMESİ'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    
If Target.Column = 2 Or Target.Column = 4 Or Target.Column = 5 Or Target.Column = 6 Or Target.Column = 9 Or Target.Column = 10 Or Target.Column = 11 Or Target.Column = 18 Or Target.Column = 19 Or Target.Column = 20 Or Target.Column = 21 Or Target.Column = 25 Then
On Error Resume Next
Application.EnableEvents = False
Target.Value = UCase(Replace(Replace(Target.Value, "ı", "I"), "i", "İ"))
Application.EnableEvents = True
Else
End If

If Target.Column = 7 Or Target.Column = 8 Or Target.Column = 22 Or Target.Column = 23 Then
Dim i As Integer, deg, deg2 As String
On Error Resume Next
Application.EnableEvents = False
Target.Value = WorksheetFunction.Proper(Target.Value)
deg = Split(Target.Value, " ")
For i = LBound(deg) To UBound(deg) - 1
deg2 = deg2 & " " & deg(i)
Next
Target.Value = deg2 & " " & UCase(Replace(Replace(deg(UBound(deg)), "ı", "I"), "i", "İ"))
Target.Value = Right(Target.Value, Len(Target.Value) - 1)
Application.EnableEvents = True
End If
'''''''''''''''''''''''''''''''''''''''''ÜRÜN BİRİM FİYATI BULMA'''''''''''''''''''''''''''''''''''''''''''''''''''''
On Error Resume Next
If Not Intersect(Target, Range("K5:K1048576")) Is Nothing Then
If Target = "" Then Exit Sub
If WorksheetFunction.CountIf(Sheets("ÜRÜNLER").Range("D:D"), Cells(Target.Row, "K")) > 0 Then
Cells(Target.Row, "P") = WorksheetFunction.VLookup(Cells(Target.Row, "K"), Sheets("ÜRÜNLER").Range("D:F"), 3, 0)
Else
Cells(Target.Row, "K") = ""
MsgBox " YAZDIĞINIZ ÜRÜN BULUNAMADI ", vbCritical, " DİKKAT !!!!! "
End If
End If

''''''''''''''''''''''''''''''''''''''''''''''''ALIŞ HESABI''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    If Target.Column = 12 Or Target.Column = 13 Then
        sat = Target.Row
        Cells(sat, "N") = Cells(sat, "L") * Cells(sat, "M")
    End If
''''''''''''''''''''''''''''''''''''''''''''''''SATIŞ HESABI''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    If Target.Column = 15 Or Target.Column = 16 Then
        sat = Target.Row
        Cells(sat, "Q") = Cells(sat, "O") * Cells(sat, "P")
    End If
''''''''''''''''''''''''''''''''''''''''''''''''GELİR HESABI''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    If Target.Column = 26 Or Target.Column = 27 Then
        Cells(Target.Row, "AB") = WorksheetFunction.Round(Cells(Target.Row, "AA") * Cells(Target.Row, "Z"), 2) / 100
        Cells(Target.Row, "AC") = WorksheetFunction.Round(Cells(Target.Row, "AB") + Cells(Target.Row, "Z"), 2)
    End If
''''''''''''''''''''''''''''''''''''''''''''''''GİDER HESABI''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    If Target.Column = 30 Or Target.Column = 31 Then
        Cells(Target.Row, "AF") = WorksheetFunction.Round(Cells(Target.Row, "AE") * Cells(Target.Row, "AD"), 2) / 100
        Cells(Target.Row, "AG") = WorksheetFunction.Round(Cells(Target.Row, "AF") + Cells(Target.Row, "AD"), 2)
    End If


''''''''''''''''''''''''''''''''''''''''''''''''GİZLE GÖSTER''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Dim Veri As String
    If Intersect(Target, Range("A4,B5:B65536,S5:S65536")) Is Nothing Then Exit Sub
        ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Veri = UCase(Replace(Replace(Range("A4"), "i", "İ"), "ı", "I"))
    Range("B:AI").EntireColumn.Hidden = False
    Select Case Veri
        Case Is = "ALIŞ"
            Range("E:G,O:AG,AJ:AK").EntireColumn.Hidden = True
            
        Case Is = "GİDER"
            Range("J:Q,T:AC,AJ:AK").EntireColumn.Hidden = True
        
        Case Is = "SATIŞ"
            Range("D:D,L:N,R:AG,AJ:AK").EntireColumn.Hidden = True
            
        Case Is = "GELİR"
            Range("D:D,J:Q,T:Y,AD:AG,AJ:AK").EntireColumn.Hidden = True
            
    End Select

    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    If Veri = "GİDER" And UCase(Replace(Replace(Cells(Target.Row, "B"), "i", "İ"), "ı", "I")) = "TAKVİM" Then
        Range("AE:AG").EntireColumn.Hidden = False
    Else
        Range("AE:AG").EntireColumn.Hidden = True
    End If
    If Veri = "GELİR" And UCase(Replace(Replace(Cells(Target.Row, "B"), "i", "İ"), "ı", "I")) = "TAKVİM" Then
        Range("AA:AC").EntireColumn.Hidden = False
    Else
        Range("AA:AC").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
    
''''''''''''''''''''''''''''''''''''''''''''''Satı Gizle'''''''''''''''''''''''''''''''''''''''''''''''''
'## ## ## ##
' 10.01.2012 16:06
If Intersect(Target, Range("A4")) Is Nothing Then Exit Sub
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=1
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=2
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=3
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=4
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=5
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=6
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=7
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=8
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=9
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=10
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=11
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=12
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=13
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=14
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=15
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=16
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=17
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=18
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=19
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=20
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=21
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=22
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=23
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=24
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=25
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=26
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=27
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=28
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=29
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=30
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=31
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=32
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=33
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=34
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=35
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=36

    Veri = UCase(Replace(Replace(Range("A4"), "i", "İ"), "ı", "I"))
    Range("B:AI").EntireColumn.Hidden = False
    Select Case Veri
        Case Is = "ALIŞ"
            Range("E:G,O:AG,AJ:AK").EntireColumn.Hidden = True
            Call kod_alış
            
        Case Is = "GİDER"
            Range("J:Q,T:AC,AJ:AK").EntireColumn.Hidden = True
            Call kod_gider
        
        Case Is = "SATIŞ"
            Range("D:D,L:N,R:AG,AJ:AK").EntireColumn.Hidden = True
            Call kod_satış
            
        Case Is = "GELİR"
            Range("D:D,J:Q,T:Y,AD:AG,AJ:AK").EntireColumn.Hidden = True
            Call kod_gelir
            
    End Select

    
    If Veri = "GİDER" And UCase(Replace(Replace(Cells(Target.Row, "B"), "i", "İ"), "ı", "I")) = "TAKVİM" Then
        Range("AE:AG").EntireColumn.Hidden = False
    Else
        Range("AE:AG").EntireColumn.Hidden = True
    End If
    If Veri = "GELİR" And UCase(Replace(Replace(Cells(Target.Row, "B"), "i", "İ"), "ı", "I")) = "TAKVİM" Then
        Range("AA:AC").EntireColumn.Hidden = False
    Else
        Range("AA:AC").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
'## ## ## ##
Application.ScreenUpdating = True
End Sub

. . .

gedavet · 10 Ocak 2012

hüseyin hocam ilginiz için çok teşekkkür ederim ancak sadece satır gizle kodunu verebilirmiisniz sütun gizleme bölümünden ayrı olsa

Emir Hüseyin Çoban · 10 Ocak 2012

. . .

Filitreleri temizleme:

Kod:

Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=1
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=2
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=3
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=4
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=5
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=6
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=7
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=8
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=9
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=10
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=11
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=12
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=13
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=14
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=15
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=16
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=17
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=18
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=19
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=20
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=21
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=22
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=23
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=24
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=25
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=26
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=27
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=28
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=29
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=30
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=31
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=32
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=33
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=34
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=35
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=36

Boş olanları kaldırma kodu:

Kod:

Sub kod_alış()
On Error Resume Next
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=13
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=13, Criteria1:="<>"
End Sub


Sub kod_satış()
On Error Resume Next
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=16
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=16, Criteria1:="<>"
End Sub

Sub kod_gelir()
On Error Resume Next
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=25
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=25, Criteria1:="<>"
End Sub

Sub kod_gider()
On Error Resume Next
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=29
Sheets("cari").ListObjects("Tablo1").Range.AutoFilter Field:=29, Criteria1:="<>"
End Sub

. . .

Emir Hüseyin Çoban · 10 Ocak 2012

. . .

Ben cari sayfası üzerinde olan kodlarda çalıştım hep.

Siz kendi kodlarınızdan bağımsız olarak, bütün sutunlar görünür olsun.
Ancak A4 de seçili verinin dolu satırlarının mı görünmesini istiyorsunuz ?

. . .

gedavet · 10 Ocak 2012

'''''''''''''''''''''''''''''''''''''''''''''''''''SÜTUN GİZLE GÖSTER''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim Veri As String
If Intersect(Target, Range("A4,B5:B1048576,S5:S1048576")) Is Nothing Then Exit Sub
Sheets("HESAP").ListObjects("Tablo17").Range.AutoFilter Field:=13
Sheets("HESAP").ListObjects("Tablo17").Range.AutoFilter Field:=16
Sheets("HESAP").ListObjects("Tablo17").Range.AutoFilter Field:=25
Sheets("HESAP").ListObjects("Tablo17").Range.AutoFilter Field:=29

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Veri = UCase(Replace(Replace(Range("A4"), "i", "İ"), "ı", "I"))
Range("B:AI").EntireColumn.Hidden = False
Select Case Veri
Case Is = "ALIŞ"
Range("E:G,O:AG,AJ:AK").EntireColumn.Hidden = True
Call kod_alış

Case Is = "GİDER"
Range("J:Q,T:AC,AJ:AK").EntireColumn.Hidden = True
Call kod_gider

Case Is = "SATIŞ"
Range("D

,L:N,R:AG,AJ:AK").EntireColumn.Hidden = True
Call kod_satış

Case Is = "GELİR"
Range("D

,J:Q,T:Y,AD:AG,AJ:AK").EntireColumn.Hidden = True
Call kod_gelir
End Select
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If Veri = "GİDER" And UCase(Replace(Replace(Cells(Target.Row, "B"), "i", "İ"), "ı", "I")) = "TAKVİM" Then
Range("AE:AG").EntireColumn.Hidden = False
Else
Range("AE:AG").EntireColumn.Hidden = True
End If
If Veri = "GELİR" And UCase(Replace(Replace(Cells(Target.Row, "B"), "i", "İ"), "ı", "I")) = "TAKVİM" Then
Range("AA:AC").EntireColumn.Hidden = False
Else
Range("AA:AC").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

'''''''''''''''''''''''''''''''''''''''''''''''''''SATIR GİZLE''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If Not Intersect(Target, Range("A4")) Is Nothing Then

Dim sOnsAt As Long, dIzi(), sUtun(), kAcinci, aLan As Range

Veri = UCase(Replace(Replace(Range("A4"), "i", "İ"), "ı", "I"))

sOnsAt = Cells.Find("*", , , , xlByRows, xlPrevious).Row
dIzi = Array("ALIŞ", "SATIŞ", "GELİR", "GİDER")
sUtun = Array(14, 17, 26, 30)

kAcinci = WorksheetFunction.Match(Veri, WorksheetFunction.Transpose(dIzi), 0)

Set aLan = Range(Cells(5, sUtun(kAcinci - 1)), Cells(sOnsAt, sUtun(kAcinci - 1)))

aLan.EntireRow.Hidden = False

On Error Resume Next
aLan.SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True

End If

hocam eskiden kodum bu şekilde idi sütun gizleme ayrı satır gizleme ayrı idi

sütun gizlemede değişiklik yok o aynı şekilde duracak
satır gizleme ise burdaki kod saır gizleme yapıyor bu şekilde yapmayacak filitreleme yapacak bu şekilde istiyorum

makro ile filitreleme yapmak

gedavet

Ekli dosyalar

Emir Hüseyin Çoban

Destek Ekibi

gedavet

Emir Hüseyin Çoban

Destek Ekibi

gedavet

Emir Hüseyin Çoban

Destek Ekibi

gedavet

Ekli dosyalar

Emir Hüseyin Çoban

Destek Ekibi

gedavet

gedavet

Emir Hüseyin Çoban

Destek Ekibi

gedavet

gedavet

Emir Hüseyin Çoban

Destek Ekibi

gedavet

Emir Hüseyin Çoban

Destek Ekibi

Emir Hüseyin Çoban

Destek Ekibi

gedavet