Filtreleme Konusunda Yardım

[anemis]

Merhaba değerli excelwebtr sakinleri.

Şirketimizde kullandığımız bir excel arşivimiz var. Bazı yazışmaların kodlarını tutuyor ve gerekli olduğu durumlarda filtreleme yaparak aradığımız yazıya ulaşıyoruz.

Bazı arkadaşlar filtreleme yaptıktan sonra geçerli filtrelemeyi kapamadan kayıt ettiklerinden exceldeki bazı fonksiyonlar kayıp oluyor. Hal böyle olunca bir çare düşündüm ve sitede benzer bir uygulama gördüğümü hatırladım.
Ancak ne yazık ki uygun aramayı gerçekleştiremediğimden sizlere danışmak istedim.

Örnek ekli dosyada da anlatmaya çalıştığım gibi, listenin üzerinde filtreleme kutucuklarına hangi değeri girersem hücresine girdiğim text e göre o stundaki tüm değerleri filtrelesin istiyorum.

Değerli yardımlarınız ve zaman ayırdığınız için şimdiden teşekkürler.

 

[Ömer BARAN]

Merhaba.

Belgeniz açıkken;
-- alt taraftan EVRAK_KAYIT sayfasının adına fareyle sağ tıklayıp KOD GÖRÜNTÜLEyi seçin,
-- açılan VBA ekranında sağdaki boş alana aşağıdaki kod'u yapıştırın,
-- belgeyi kapatırken belgenizi MAKRO İÇEREBİLEN.... şeklinde kaydedin.

Kod, A3:R3 hücre aralığına yazacağınız verilere göre, veri yazdığınız sütuna EŞİTTİR mantığına göre filtre uygulayacaktır.
.

[B]Private Sub Worksheet_Change(ByVal Target As Range)[/B]
If Intersect(Target, [[B][COLOR="Red"]A3:R3[/COLOR][/B]]) Is Nothing Then Exit Sub
Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
For sut = 1 To 13
ActiveSheet.Range("A3:R3").AutoFilter Field:=sut
    If sut = 1 Then kriter = "=" & WorksheetFunction.Rept("0", 3 - Len(Cells(3, sut))) & Cells(3, sut)
    If sut <> 1 Then kriter = "=" & Cells(3, sut)
If Cells(3, sut) <> "" Then ActiveSheet.Range("A3:R3").AutoFilter Field:=sut, Criteria1:=kriter
Next
Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
[B]End Sub[/B]

 

[anemis]

Sayın Ömer Baran Çok teşekkür ederim emeğinize. Yarın ilk iş deneyeceğim.

 

[anemis]

Merhaba.

Belgeniz açıkken;
-- alt taraftan EVRAK_KAYIT sayfasının adına fareyle sağ tıklayıp KOD GÖRÜNTÜLEyi seçin,
-- açılan VBA ekranında sağdaki boş alana aşağıdaki kod'u yapıştırın,
-- belgeyi kapatırken belgenizi MAKRO İÇEREBİLEN.... şeklinde kaydedin.

Kod, A3:R3 hücre aralığına yazacağınız verilere göre, veri yazdığınız sütuna EŞİTTİR mantığına göre filtre uygulayacaktır.
.

[B]Private Sub Worksheet_Change(ByVal Target As Range)[/B]
If Intersect(Target, [[B][COLOR="Red"]A3:R3[/COLOR][/B]]) Is Nothing Then Exit Sub
Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
For sut = 1 To 13
ActiveSheet.Range("A3:R3").AutoFilter Field:=sut
    If sut = 1 Then kriter = "=" & WorksheetFunction.Rept("0", 3 - Len(Cells(3, sut))) & Cells(3, sut)
    If sut <> 1 Then kriter = "=" & Cells(3, sut)
If Cells(3, sut) <> "" Then ActiveSheet.Range("A3:R3").AutoFilter Field:=sut, Criteria1:=kriter
Next
Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
[B]End Sub[/B]

Sayın Ömer Bey;

Kodlar sorunsuz çalıştı emeğinize sağlık. Çok teşekkür ederim tam istediğim gibi oldu.

 

[anemis]

Merhabalar;

Filtreleme kısmı Sayın Ömer hocamın verdiği kod ile sıkıntısız çalışıyor. Ancak ne yazık ki bazı arkadaşların inadı devam ediyor

Acaba 3 numaralı satırda yazılan (A3:R3 arası) text leri dosyayı kapatırken veya kayıt ederken otomatik silmek mümkün müdür? Dosyayı kayıt etmeden önce otomatikmen filtreleme kaybolsun istiyoruz.

Öneri ve yardımlar için tekrar teşekkür ederim.

 

[YUSUF44]

Aşağıdaki kodları VBA sayfasında BuÇalışmaKitabı'nın kod bölümüne yapıştırırsanız kapatmadan önce istediğiniz gibi hücreleri boşaltır:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Sheets("EVRAK_KAYIT").[A3:R3].ClearContents
End Sub

 

[anemis]

Aşağıdaki kodları VBA sayfasında BuÇalışmaKitabı'nın kod bölümüne yapıştırırsanız kapatmadan önce istediğiniz gibi hücreleri boşaltır:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Sheets("EVRAK_KAYIT").[A3:R3].ClearContents
End Sub

Sayın Yusuf Bey; Çok teşekkür ederim. Kod kapatmadan önce belgeyi harika çalışıyor.
Aslında işimi tamamen görüyor gibi ancak eğer çok birşey istemiş olmayacak isem,
kapatmak yerine belge açıkken kayıt etmek istendiğinde de filtrelenen satırdaki değerler otomatik silenbilir mi?

Private Sub Workbook_Before[COLOR="Red"]Save[/COLOR](Cancel As Boolean)

şeklinde denedim ama sonuç alamadım

 

[YUSUF44]

Diğer verdiğim kodla aynı yere aşağıdaki kodu yapıştırarak deneyiniz:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Sheets("EVRAK_KAYIT").[A3:R3].ClearContents
End Sub

 

[anemis]

Sayın Yusuf hocam. Gerçekten tam istediğim şey oldu. Çok teşekkür ediyorum elinize, emeğinize sağlık. Harikasınız