Fİltreleme YapildiĞinda Sira Numarasinin Otomatİk Verİlmesİ

[apran]

Ektekİ Dosyada Anlattim. Fİltreleme YaptiĞimda Sadece Fİltrede GÖrÜnenlere Sira Numarasi Verİlmesİ Ve Fİltrelenen BÖlÜmÜn Adinin BaŞliĞa Yazilmasini Nasil Yapabİlİrİz... Örnek Dosya Ektedİr. Yardimlariniz İÇİn TeŞekkÜrler...

 

[mehmett]

Dosyanız ekte.

Sonradan düzeltme: Moduldeki fazla kodları sildim.

 

[Recep İpek]

Daha basit çözümü olabilir ama makro ile yaptığım çalışmayı ekteki dosyada bulabilirsiniz.

 

[Ali]

Ufak bir fonksiyon ve makro ile halledilebilir. Örneğiniz ektedir.

Not: Süzme için Levent Bey'in daha önce önerdiği makrodur.

 

[Mdemir63]

Dosyanız ekte.

Hocam Günaydın aşağıdaki yazdığınız kodların ne anlama geldiğini açıklayabilirmisiniz.

Saygılar

Sayfa1 içine yazılan
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [D3]) Is Nothing Then Exit Sub
If [D3] = "" Then
Selection.AutoFilter Field:=16
Selection.AutoFilter
Else
Range("B5:Q17").Select
Selection.AutoFilter Field:=16, Criteria1:=[D3]
Range("B5").Select
End If
End Sub


Modül içine yazılan
Sub Makro1()
Range("B5:Q17").Select
Selection.AutoFilter Field:=16, Criteria1:=[D3]
Range("B5").Select
End Sub
Sub Makro2()
'
' Makro2 Makro
' Makro mehmet tarafından 25.01.2007 tarihinde kaydedildi.
'

'
Selection.AutoFilter Field:=16

End Sub

 

[mehmett]

Sn komutan63

Modüle içine yazılanı boşverin. Önce modül içinde yazdım makroyu sonra Sayfa1'e kopyaladım. Modüldekini silmeyi unutmuşum.

Sayfa1'deki kodların anlamları ise kısaca şöyle;

Private Sub Worksheet_Change(ByVal Target As Range) [COLOR=royalblue]'Sayfa1 değiştikçe makro çalışacak (Makro, change olayına bağlı)[/COLOR]
If Intersect(Target, [D3]) Is Nothing Then Exit Sub [COLOR=royalblue]'Sadece D3 hücresine bağlı kal, yani D3 teki değer değiştikçe makro çalışsın.[/COLOR]
If [D3] = "" Then [COLOR=royalblue]'Eğer D3 boş ise[/COLOR]
Selection.AutoFilter Field:=16 
Selection.AutoFilter [COLOR=royalblue]'Sayfadaki süzme işlemini kaldır (Bunun daha basit bir kodu olabilirdi.[/COLOR])[COLOR=royalblue] D3 boşaltılırsa listenin tamamı görülüyor.[/COLOR]
Else [COLOR=royalblue]'Yoksa[/COLOR]
Range("B5:Q17").Select [COLOR=royalblue]'B5:Q17 alanını seç[/COLOR]
Selection.AutoFilter Field:=16, Criteria1:=[D3] [COLOR=royalblue]'Seçilen alanı D3'teki değeri kriter alarak süz[/COLOR]
Range("B5").Select [COLOR=royalblue]'B5 hücresine git[/COLOR]
End If
End Sub

 

[a.akyurek]

Ektekİ Dosyada Anlattim. Fİltreleme YaptiĞimda Sadece Fİltrede GÖrÜnenlere Sira Numarasi Verİlmesİ Ve Fİltrelenen BÖlÜmÜn Adinin BaŞliĞa Yazilmasini Nasil Yapabİlİrİz... Örnek Dosya Ektedİr. Yardimlariniz İÇİn TeŞekkÜrler...

"Merge Cells" komutunun veri ve formül alanlarına uygulanması zorluk çıkarır...

B1: SEÇİLEN BÖLÜM

B2:

Control+shift+enter...

=IF(SUBTOTAL(3,G6:G17)=COUNTA(G6:G17),"",INDEX(G6:G17,MATCH(1,SUBTOTAL(3,OFFSET(G6:G17,ROW(G6:G17)-ROW(G6),,1)),0)))

B6:

=SUBTOTAL(3,$G$5:G6)-1

Türkçe sistem yukardakileri Türkçe'de yansıtır.

 

[Mdemir63]

Sn komutan63

Modüle içine yazılanı boşverin. Önce modül içinde yazdım makroyu sonra Sayfa1'e kopyaladım. Modüldekini silmeyi unutmuşum.

Sayfa1'deki kodların anlamları ise kısaca şöyle;

Private Sub Worksheet_Change(ByVal Target As Range) [COLOR=royalblue]'Sayfa1 değiştikçe makro çalışacak (Makro, change olayına bağlı)[/COLOR]
If Intersect(Target, [D3]) Is Nothing Then Exit Sub [COLOR=royalblue]'Sadece D3 hücresine bağlı kal, yani D3 teki değer değiştikçe makro çalışsın.[/COLOR]
If [D3] = "" Then [COLOR=royalblue]'Eğer D3 boş ise[/COLOR]
Selection.AutoFilter Field:=16 
Selection.AutoFilter [COLOR=royalblue]'Sayfadaki süzme işlemini kaldır (Bunun daha basit bir kodu olabilirdi.[/COLOR])[COLOR=royalblue] D3 boşaltılırsa listenin tamamı görülüyor.[/COLOR]
Else [COLOR=royalblue]'Yoksa[/COLOR]
Range("B5:Q17").Select [COLOR=royalblue]'B5:Q17 alanını seç[/COLOR]
Selection.AutoFilter Field:=16, Criteria1:=[D3] [COLOR=royalblue]'Seçilen alanı D3'teki değeri kriter alarak süz[/COLOR]
Range("B5").Select [COLOR=royalblue]'B5 hücresine git[/COLOR]
End If
End Sub

Hocam çok teşekkürler

Kolay gelsin

Saygılar

 

[Mdemir63]

Ufak bir fonksiyon ve makro ile halledilebilir. Örneğiniz ektedir.

Not: Süzme için Levent Bey'in daha önce önerdiği makrodur.

Ali hocam teşekkürler elinize sağlık

Saygılar

 

[apran]

Teşekkürler

Yardımcı olan herkese çok teşekkürler.