birden çok sütunda metin parçalarına göre süzme makro

[modoste]

merhaba sayın hocalarım
ekli dosyamda bir sütundaki metin parçasına göre listenin süzülmesi ile ilgili formülle çözüm bulunuyor
benim istediğim ise tablonun sağındada açıklamasını yaptığım
birden çok sütundaki metin parçaları kriterlerine göre makro ile süzme sıralama yapılması.

 

[Ömer BARAN]

Merhaba.

-- J3 ve K3 hücrelerinin biçimini METİN olarak ayarlayın,
-- J:M sütun aralığındaki formülleri silin,
-- alt taraftan ilgili sayfa adına fareyle sağ tıklayıp KOD GÖRÜNTÜLEyi seçin,
-- açılan VBA ekranında sağ taraftaki boş alana aşağıdaki kod'u yapıştırın

-- Hem J3 boş, hem K3 boş iken J:M sütun aralığındaki listenin boş olmamasını istiyorsanız, kırmızı renklendirdiğim satırı silin.
.

[B]Private Sub Worksheet_Change(ByVal Target As Range)[/B]
If Intersect(Target, [J3, K3]) Is Nothing Then Exit Sub
If Cells(Rows.Count, "J").End(3).Row > 5 Then Range("J6:M" & Cells(Rows.Count, "J").End(3).Row).ClearContents
[COLOR="Red"]If [J3] = "" And [K3] = "" Then Exit Sub[/COLOR]
If [J3] <> "" Then Range("C5:F" & Cells(Rows.Count, 3).End(3).Row).AutoFilter Field:=1, Criteria1:="*" & [J3].Text & "*"
If [K3] <> "" Then Range("C5:F" & Cells(Rows.Count, 3).End(3).Row).AutoFilter Field:=2, Criteria1:="*" & [K3].Text & "*"
If Cells(Rows.Count, 3).End(3).Row = 5 Then GoTo 10
Range("C6:F" & Cells(Rows.Count, 3).End(3).Row).SpecialCells(xlCellTypeVisible).Copy [J6]
10: Range("C5:F" & Cells(Rows.Count, 3).End(3).Row).AutoFilter
[B]End Sub[/B]

 

[modoste]

teşekkür ederim sayın ömer baran
kullanmaya başladım makrolu çizelgeyi

 

[Ömer BARAN]

teşekkür ederim sayın ömer baran
kullanmaya başladım makrolu çizelgeyi

Kolay gelsin.
.

 

[modoste]

sayın Ömer.Baran hocam bu istediğim çözümden daha başka yani daha fazla sütunların kullanılacağı çizelgelerde ileride karşıma çıkıcam buna dönük bir çalışma yapabilirmisiniz

örneğin veriler B-C-D-E-F-G-H-I-İ-J diyelim yani 10 sütun için aynı mantıkta makro yapabilir misiniz.

 

[modoste]

eklediğim dosyada verilen listeye göre belirlediğim kriterlere göre makro ile süzme yapabilirmiyiz.

 

[modoste]

makro ile süzme

yeni bir dosya ile soru

 

[modoste]

sayın hocalarımdan makro ile çözüm gelene kadar formülle çözüm üretmeye çalıştım
faydası olur diye eklemek istedim.
8 sütundaki kriterlere göre kiminde sayısal kiminde metinsel ifadelere göre süzme yapmaya çalıştım

 

[modoste]

sayın Ömer BARAN Hocam
bu konuyla ilgili yeni bir makro isteğim olacaktı hocam
2 sene boyunca kullandığım tablomda veriler 4 sütundan ibaretti ve ona göre 2 sütundaki metin veya metin parçasına göre makro ile süzme yapmıştınız. şimdi ise veriler 5 sütuna çıktı ve ben bu sefer en fazla 3 sütunda kriter yazarak makro ile sonuç elde etmek istiyorum
ekli dosyamda "ilk makro" dosyasında ilk durum sizin çözümünüzle kullandığım durum
"2. istek makro" dosyasında ise sorumu ilettim. veriler C6:G6 aralığından başlayacak K3,L3 ve M3 sekmesinde ifade yazılacak eğer 3 üne yazılırsa 3 lü süzme eğer birine veri yazılırsa tek süzme gibi makro yapılcak hocam
(makroda ben hücrelere veri yazıp enter dediğimde makro çalışıyordu yine o dönüşümde olmalı)
Not: eski çözümdeki makrodaki, kodu dönüştürmeye çalıştım harfleri kaydırmaya çalıştım ama başaramadım hocam.

ekli dosyalarımın her biri 1,90 mb olduğundan bu şekilde eklemek zorunda kaldım hocam

 

[Ömer BARAN]

Umarım yanlış anlamadım.
Alt taraftan YENİ İSTEK saysının adına fareyle sağ tıklayıp KOD GÖRÜNTÜLEyi seçin,
açılan ekranda sağdaki alana aşağıdaki kod blokunu yapıştırın.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [K3:M3]) Is Nothing Then Exit Sub
If Cells(Rows.Count, "K").End(3).Row > 5 Then _
    Range("K6:O" & Cells(Rows.Count, "K").End(3).Row).ClearContents
If [K3] = "" And [L3] = "" And [M3] = "" Then Exit Sub
cson = Cells(Rows.Count, 3).End(3).Row
If [K3] <> "" Then Range("C5:G" & cson ).AutoFilter Field:=1, Criteria1:="*" & [K3].Text & "*"
If [L3] <> "" Then Range("C5:G" & cson ).AutoFilter Field:=2, Criteria1:="*" & [L3].Text & "*"
If [M3] <> "" Then Range("C5:G" & cson ).AutoFilter Field:=3, Criteria1:="*" & [M3].Text & "*"
If Cells(Rows.Count, 3).End(3).Row = 5 Then GoTo 10
Range("C6:G" & cson).SpecialCells(xlCellTypeVisible).Copy [K6]
10: Range("C5:G" & cson ).AutoFilter
End Sub

 

[modoste]

uyguladım teşekkür ederim sayın ömer hocam
daha fazla sütun eklenirse modüldeki satır sütun yardımcı olur dimi hocam Kırmızı koyu renkle belirttiklerini değiştirdiğim taktirde yeni sonuçlar elde edilir.

 

[Ömer BARAN]

Sorun olursa yine yazarsınız, bakarım.