Satır Gizleme veya Süz

[vivident]

A sutununda koşulu sağlayan satırlara otomatik olarak formül ile 1 rakamı ekleniyor. Satır gizleme makrosu ile 1' i gören satırlar otomatik gizlenecek. Eğer satırdaki 1 yok olursa satır tekrar açılacak. Fakat bunların hepsi otomatik olacak. yani butona basarak veya hücreye manuel 1 rakamı yazarak değil

Satır gizleme makrosunu forumdan buldum. uyguladım ama, otomatik çalışmıyor, hücrenin içine 1 yazınca çalışıyor

Kod aşağıdaki gibidir ;

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("A1:A800")) Is Nothing Then Exit Sub
If Target = 1 Then
Range("A" & Target.Row).EntireRow.Hidden = True
Else
Range("A" & Target.Row).EntireRow.Hidden = False
End If
End Sub

 

[Muzaffer Ali]

Dosyanızı açamadım hata veriyo.
Aşağıdaki kodları dener misiniz?

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)

If cells(target.row,1).value=1 Then
Range("A" & Target.Row).EntireRow.Hidden = True
Else
Range("A" & Target.Row).EntireRow.Hidden = False
End If
End Sub

 

[vivident]

Denedim ama olmadı. Dosyayı bir kez daha ekledim

Şimdilik örnek amaçlı A sütunundaki satıralara 1 rakamını F3 hücresine 1 rakamı yazarak getiriyorum, fakat gerçek dosyamda orada formüller olacak.

 

[vivident]

Hocam daha da sadeleştirilmiş bir dosya ekledim. A sutununda 1 rakamı olan hücreler formül ile geliyor

 

[Muzaffer Ali]

Şu kod işinizi görür mü?

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Target.Address = "$D$1" Then Exit Sub
    Dim Say As Integer
    Dim Bak As Integer
    Say = Range("A" & Cells.Rows.Count).End(3).Row
    For Bak = 3 To Say
        If Cells(Bak, 1).Value = 1 Then
            Cells(Bak, 1).EntireRow.Hidden = True
        Else
            Cells(Bak, 1).EntireRow.Hidden = False
        End If
    Next
End Sub

 

[vivident]

Kodu denedim, kodun adresi D1 hücresi olarak göstermişsiniz. D1 hücresi 1 olunca kod devreye giriyor. D1 hücresinde hiçbirşey yoksa veya 1 rakamından farklı değer varsa gizlenen satırlar geriye gelmiyor.

Ayrıca ben D1 hücresini hiç dikkate almanızı istemiyorum. A sutununda hücrelerde 1 rakamları oluşsun ve gizlenen hücrelerde 1 rakamı yok olunca tekrar satırlar geri geliyormu diyerek D1 hücresine değer eklemiştim (deneme amaçlı)

Karışık gibi görünüyor fakat sadece A sutunundaki satırlarda 1 rakamın görünce satırı gizlesin, satırdaki 1 rakamı yok olunca satırı açsın. Hücrelerde 1 rakamının oluşması ve silinme işlemini ben daha sonra formül ile yazacağım.

 

[vivident]

Lütfen yardım veya bir yol gösterin forum üyeleri, Bugüne kadar dosya ile yaptıklarım aşağıdaki gibidir. Fakat çözemedim bir türlü
Ek'te 3 adet dosya var

1. dosyada kullanılan kod (butona bağlı hızlı açma - kapama yapıyor);

Sub Gizle()
    Dim Alan As Range
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
 
    For Each Alan In Range("E5:E100")
        If Alan.Value <> "" And Alan.Value = " " Then
            Alan.EntireRow.Hidden = True
        End If
    Next
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub
Sub Göster()
    Dim Alan As Range
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
 
    For Each Alan In Range("E5:E100")
        If Alan.Value <> "" And Alan.Value = " " Then
            Alan.EntireRow.Hidden = False
        End If
    Next
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub

2. dosyada kullanılan kod (butona bağlı adım adım açma - kapama yapıyor);

Sub Gizle()
For Each t In Range("E5:E100").Cells
If t.Value = " " Then 'boş hücreleri gizler
t.EntireRow.Hidden = True
End If
Next t
End Sub
Sub Göster()
For Each t In Range("E5:E100").Cells
If t.Value = " " Then 'boş hücreleri gösterir
t.EntireRow.Hidden = False
End If
Next t
End Sub

3. dosyada kullanılan kod (H1 hücresine bağlı, hücreyi "ES" yapınca filireleme yaparak süzüyor);

Private Sub Worksheet_Change(ByVal Target As Range)
Application.Calculation = xlCalculationManual
On Error Resume Next
Application.Calculation = xlCalculationManual
If Intersect(Target, [H1]) Is Nothing Then Exit Sub
If ActiveSheet.AutoFilterMode = False Then [E4].AutoFilter
Application.ScreenUpdating = False
If Target = "" Then
ActiveSheet.ShowAllData
Exit Sub
End If
Application.Calculation = xlCalculationManual
sut = WorksheetFunction.Match(Target, [4:4], 0)
ActiveSheet.ShowAllData
[E4].AutoFilter Field:=sut, Criteria1:=">0"
Application.Calculation = xlCalculationManual
End Sub

Tek tek bakıldığında hepsi çalışıyor. Eeeee daha ne istiyorsun demeyin, Benim istediğim ;

Özet tabloda (il, ilçe örneğini düşünün, ona benzer)
F sutununda süreye göre ilk 10 (iller) tanım
F sutunundaki herhangi bir satırdaki tanımın alt bileşeneleri açılınca (G sutunu yani) süreye göre ilk 5 (ilçe) referansın gelmesini istediğim için satır gizleme veya süzme olayını yapmak istiyorum.

Her defasında butona tıklayarak veya filitreden seçme yaparak değil. Otomatik olarak E sutunundaki 1 rakamlarını görünce kapanması, 1'ler yok olunca açılması