combo box seçimine göre boş satır gizleme-görüntüleme

[abrekahmet]

Merhaba, F2 hücresinde bulunan combo box tercihine göre farklı bir veri sayfasından alınan veriler aynı sayfada A4 hücresinden itibaren değişik satırlar aktif hale geliyor. bu satırlar dağınık şekilde a4 ile a260 arasında olabilir. dolu olan satırların a sütunundaki karşılığı rakam olarak dolu oluyor. ihtiyacım olan makro şu;

- combo daki seçimden sonra A4 hücresinden itibaren dolu olmayan satırların gizlenmesi. bu yapılırken a260 a kadar gizlenmesi zaman alacağından, en son dolu olan a hücresini baz alarak a4 ten son dolu olan a hücresi arasındaki boş satırları gizlemek.

- bu şekilde dolu olan satırların bir araya gelmesinin sağlandığı bir durumda F2 hücresinde bulunan combo dan yeni bir tercih yaptığımızda yeni gelen bilgiler değişik satırlarda oluşabiliyor. bu nedenle önceki tercihten gizlenen boş satırlarında dolabileceği bir durum olacaktır. dolayısıyla; son haliyle dolu olan ancak gizli kalan bu satırlarında ikinci tercihle birlikte tekrar açılması ve önceki tercihle dolu ancak son tercihle boş kalanlarında gizlenmesi gerekir.

- bu makronun çalışması ise yalnızca combo box taki seçimle mümkün olmalı. örnek dosya ektedir.

teşekkür ederim.

 

[Ömer]

Merhaba,

Çalışma sayfasının kod bölümüne kopyalayın. Bu tür işlemlerde sütun gizlemeye gerek yok, makro kullanılacaksa verileri istediğiniz format da listelemek daha doğru olacaktır.

Private Sub Worksheet_Change(ByVal Target As Range)
 
    Dim Sd As Worksheet, sat As Long, c As Range, Adr As Variant
 
    If Intersect(Target, Range("F2")) Is Nothing Then Exit Sub
 
    Set Sd = Sheets("data")
    Range("A3:C" & Rows.Count).ClearContents
 
    sat = 3
    With Sd.Range("A:A")
        Set c = .Find(Target, , xlValues, xlWhole)
        If Not c Is Nothing Then
            Adr = c.Address
            Do
                Cells(sat, "A") = sat - 2
                Cells(sat, "B") = Sd.Cells(c.Row, "A")
                Cells(sat, "C") = Sd.Cells(c.Row, "B")
                sat = sat + 1
                Set c = .FindNext(c)
            Loop While Not c Is Nothing And c.Address <> Adr
        End If
    End With
 
End Sub

Not: İstediğiniz türdeki listeleme formülle de yapılabilir.

 

[abrekahmet]

Ömer Bey, ilgili sayfaya makroyu kaydettim ancak çalıştığına dair bir belirti yok. bu makronun f2 deki combo box seçimiyle çalışması gerekiyor.

 

[Ömer]

Ömer Bey, ilgili sayfaya makroyu kaydettim ancak çalıştığına dair bir belirti yok. bu makronun f2 deki combo box seçimiyle çalışması gerekiyor.

Yanlış uygulamış olabilirsiniz. F2 deki değişmle makro çalışır. Dosya ektedir.

.

 

[abrekahmet]

Ömer Bey maalesef çalışmıyor. f2 deki değeri değiştirdiğimde formüller vasıtasıyla yeni oluşan aktif satırların arasında kalan boşluklar gine aynı şekilde kalıyor. ayrıca örnek1 dosyasında makro gelmedi. güvenlik seviyesiyle ilgili bir sıkıntı olabilir.

 

[Ömer]

Benim eklediğim dosyada formül yok.

Sizin makro güvenlik ayarlarınız düşük mü?

 

[abrekahmet]

Ömer Bey, belki alakalı olabilir diye yazıyorum. boş olan A sütunundaki hücre. satırın tümü boş değil bu nedenle a sütunundaki hücrenin boş yada dolu olarak değerlendirilmesi gerekir. ayrıca ekte makronuzun kayıtlı olduğu örnek bir dosya var. size zahmet inceleyebilirmisiniz.

 

[Ömer]

Makroyu module değil, sayfanın kod bölümüne kopyalamanız gerekir. Eklediğim örnek dosyada kodların nerde olduğuna dikkat ediniz. Ayrıca formülle artık bir alakamız yok, dosyanıza formüle eklemenize gerek yok. Örnek dosyayı incelemediniz mi?

 

[abrekahmet]

Merhaba Ömer Bey,
dediğiniz gibi ilgili kodu modülden değil sayfa isminin olduğu yerden kaydettim.
ancak bu sefer hata bildiren mesaj kutusu çıktı:

Run-time error '9':
Subcript out of range

kod bölümünü açtığımda ise aşağıdaki satırı sarı işaretli olarak görüyorum.

Sub gizle()

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Sd As Worksheet, sat As Long, c As Range, Adr As Variant

If Intersect(Target, Range("F2")) Is Nothing Then Exit Sub

Set Sd = Sheets("data")
Range("A3:C" & Rows.Count).ClearContents

sat = 3
With Sd.Range("A:A")
Set c = .Find(Target, , xlValues, xlWhole)
If Not c Is Nothing Then
Adr = c.Address
Do
Cells(sat, "A") = sat - 2
Cells(sat, "B") = Sd.Cells(c.Row, "A")
Cells(sat, "C") = Sd.Cells(c.Row, "B")
sat = sat + 1
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> Adr
End If
End With

End Sub

 

[Ömer]

İlk olarak;

Sub gizle()

Benim eklediğim kodlarda bu şekilde bir satır yok. Ben size kodlarıda verdim, örnek dosyada ekledim fakat siz kendiniz eklemeler yapıyorsunuz. Bu durumda hata vermesi normaldir.

Sadece 2. mesajdaki kodları anasayfa'nın kod bölümüne kopyalayın. Bu bölümde başka kod varsa silin, sadece benim verdiklerim kalsın.

 

[abrekahmet]

Ömer Bey, ben farklı birşey eklemedim. şu an yeniden denedim ve ikinci sayfadaki vermiş olduğunuz kodları sayfanın adının olduğu yere yani sayfa 14 (Mülakat Giriş) isimli sayfaya kod olarak ekledim. ancak bir önceki mesajımdaki mesaj kutusu çıktı ve debugdan girdiğimde kodlar aşağıdaki gibi ve Set Sd = Sheets("data") tanımlı satır sarı renkli.

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Sd As Worksheet, sat As Long, c As Range, Adr As Variant

If Intersect(Target, Range("F2")) Is Nothing Then Exit Sub

Set Sd = Sheets("data")
Range("A3:C" & Rows.Count).ClearContents

sat = 3
With Sd.Range("A:A")
Set c = .Find(Target, , xlValues, xlWhole)
If Not c Is Nothing Then
Adr = c.Address
Do
Cells(sat, "A") = sat - 2
Cells(sat, "B") = Sd.Cells(c.Row, "A")
Cells(sat, "C") = Sd.Cells(c.Row, "B")
sat = sat + 1
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> Adr
End If
End With

End Sub

 

[Ömer]

Peki, bu haliyle ( hata alınan dosyayı ) eklemeniz mümkün mü?

 

[abrekahmet]

ziplersem belki gönderebilirim çünkü bir çok sayfadan oluşuyor. deneyeyim. msn adresinizi verebilirmisiniz oraya göndereyim.

 

[abrekahmet]

Ömer Bey, acilen çıkmam gerekiyor. bu kodun çalışması benim için çok önemli siz msn yi yazarsanız akşam saatlerinde göndereceğim. kolay gelsin

 

[Ömer]

İlk eklediğiniz dosyada, verileri data sayfasından almaktadır.

Set Sd = Sheets("data")

Buradaki tanımlama bu yüzden yapıldı. Eğer dosyanızdaki veri alınacak sayfa adı farklı ise bu kod satırındaki "data" yerine yeni sayfa adını yazmanız gerekir.

 

[abrekahmet]

Ömer Bey, makro ayarlarını düşük seviyeye getirince sizin gönderdiğiniz örnek dosyasını çalıştırabildim gerçekten çok güzel ellerinize sağlık. hiç formüle gerek kalmadan data sayfasından alıyor. ancak, benim yapmış olduğum sayfa biraz farklı çalışıyor. data diyeceğimiz sayfalar çok sayıda yalnızca bir sayfa değil. ayrıca combobox a göre oluşacak satırların I sütunuyla kesiştiği hücreye not giriyoruz. bir sonraki combo seçiminde ise bazı isimler aynı kalarak aynı satırda kalıyor ve yeni kişiler eklenebiliyor. işte bu aynı kalacak satırlarda oluşan aynı kişilere ise aynı notun verilmesi gerektiğinden dolayı yerinden oynamaması lazım. bu nedenle boş satırların gizlenmesi benim karışık olan tablomda faydalı olacak. sizin verdiğiniz kodlar ise inanın aylardır farklı birşey için araştırıyordum orda kullanmayı düşünüyorum müsadenizle.
Ömer hocam isterseniz benim dosyayı göndereyim size bir inceleyin yazarak anlatmak belki yeterince anlaşılır olamayabiliyor.

 

[Ömer]

Dosyanızı küçültüp içerisinde detaylı açıklama yaparak foruma eklermisiniz.

 

[abrekahmet]

Ömer Bey, dosya ekte bulunuyor. dosyanın "Mülakat Giriş" sekmesinde I sütununa notlar veriliyor. f2 hücresindeki (combobox) seçimle birlikte ilgili sayfadaki sıralamanın değiştiğini göreceksiniz. ancak, bu seçimle birlikte iki programı tercih eden adayların isimleri sabit kalarak I hücresinde daha önce verilen notun aynen kalması gerekiyor. bu nedenle a hücresindeki değeri boş olan satırların gizlenerek sayfanın kullanışlı hale gelmesi gerekiyor.

 

[Ömer]

Ömer Bey, dosya ekte bulunuyor. dosyanın "Mülakat Giriş" sekmesinde I sütununa notlar veriliyor. f2 hücresindeki (combobox) seçimle birlikte ilgili sayfadaki sıralamanın değiştiğini göreceksiniz. ancak, bu seçimle birlikte iki programı tercih eden adayların isimleri sabit kalarak I hücresinde daha önce verilen notun aynen kalması gerekiyor. bu nedenle a hücresindeki değeri boş olan satırların gizlenerek sayfanın kullanışlı hale gelmesi gerekiyor.

Mülakat giriş sayfasındaki kodları silip aşağıdakileri yapıştırın. İstediğiniz gibi sadece gizleyip gösteren kodu yazdım.

Yalnız sayfa koruma şifresi olduğu için deneyemedim. Kodlardaki "123" yerine kendi şifrenizi yazarsınız. Dosya eklerken şifresiz yada şifreleri paylaşmanızı rica ederim.

Private Sub Worksheet_Change(ByVal Target As Range)
 
    Dim i As Long
 
    If Intersect(Target, Range("F2")) Is Nothing Then Exit Sub
    With Application
        .Calculation = xlManual
        .ScreenUpdating = False
    End With
 
    ActiveSheet.Unprotect "123"
        Cells.EntireRow.Hidden = False
        For i = 4 To Cells(Rows.Count, "C").End(xlUp).Row
            If Cells(i, "C") = "" Then
                Rows(i).EntireRow.Hidden = True
            End If
        Next i
    ActiveSheet.Protect "123"
 
    With Application
        .Calculation = xlAutomatic
        .ScreenUpdating = True
    End With
 
End Sub

.

 

[abrekahmet]

Ömer Bey, harika oldu çok teşekkür ederim. gayet güzel çalışıyor. bir düzeltme yapabilirmiyiz; normalde 260. satırdan en son satıra kadar gizliydi. şimdi gizli satırlarıda açarak formüllerin ortaya çıkmasına neden oluyor. gizleme sınırlı olabilirmi? yani 1000. satıra kadar mesela. daha sonrasını açmayacak şekilde. Birde, satırlar gizlendiğinde gizlenmiş şekilde kalan I sütunundaki notların silinmesi mümkünmüdür?