Field Koşulunu Değişken Yapmak

Katılım
27 Ekim 2020
Mesajlar
14
Excel Vers. ve Dili
Office 2019
Merhabalar

Excelde bir adet tablom var A2:D35 hücreleri arasında değişken veriler içeriyor ve aşağıdaki kodları kullanarak bir filteleme yapıyorum. fakat burda anladığım kadarıyla field:=1 yazarsak A.sütununda 2 yazarsak B. sütununda filtreleme yapıyoruz. Ben A sütünunda filtreleme yapsın bulamazsa B. sütununa geçsin orda filtreleme yapsın ve bu durum D sütununa kadar devam etsin istiyorum. Bunu nasıl yapabilir. Excel VBA da çok yeniyim üstadlar yardımcı olursanız sevinirim.
 
Katılım
27 Ekim 2020
Mesajlar
14
Excel Vers. ve Dili
Office 2019
Private Sub Worksheet_Change(ByVal Target As Range)

On Error Resume Next

ara = Worksheets("Sheet1").Range("B1").Value

If ara = "" Then

ActiveSheet.ShowAllData

Else

ActiveSheet.Range("A2:D35").AutoFilter Field:=2, Criteria1:="*" & ara & "*"

End If
End Sub
 

Ömer

Moderatör
Yönetici
Katılım
18 Ağustos 2007
Mesajlar
21,424
Excel Vers. ve Dili
2016-Türkçe
Merhaba,

Deneyiniz.
Kod:
Private Sub Worksheet_Change(ByVal Target As Range)

    Dim c As Range, ara, fld As Integer

    If Intersect(Target, Range("B1")) Is Nothing Then Exit Sub
   
    If ActiveSheet.FilterMode = True Then
        ActiveSheet.ShowAllData
    End If
   
    Set c = [A2:D100000].Find(Target, , xlValues, xlWhole)
    If Not c Is Nothing Then
        fld = c.Column
    Else
        Exit Sub
    End If
   
    ara = Worksheets("Sheet1").Range("B1").Value
   
    ActiveSheet.Range("A2:D35").AutoFilter Field:=fld, Criteria1:="*" & ara & "*"

End Sub
 
Katılım
27 Ekim 2020
Mesajlar
14
Excel Vers. ve Dili
Office 2019
Ömer bey yardımlarınız için teşekkür ederim. Sütunlarda tek tek arama yapıyor aslında doğru olmuş ama iki adet sorun çıkıyor
1. eğer B sütüunundan bir içerik aratıyorsak değerleri bize gösteriyor. Ama diğer sütunlardan bir içerik aratıyorsak doğru sütunda arama yapıyor ama içeriğin olduğu satırı göstermiyor.

Örnek: . B sütununda a harfi ile başlayan içeriklerin mevcut ve "a" diye arama yaptığımda B sütununda bulunan a harfini içeren tüm satırlar geliyor fakat A sütununda da içeriği 6a diye bir ifade var bunun bulunduğu satırı getirmiyor. Aynı şekilde C ve D sütunlarında da a harfini içeren değerler olabilir bunlarda gelmiyor.

2. B1 hücresini sildikten sonra (arama yapılan kutucuğu) B sütunundaki filitreleme sembolü seçili kalıyor.
 

Ömer

Moderatör
Yönetici
Katılım
18 Ağustos 2007
Mesajlar
21,424
Excel Vers. ve Dili
2016-Türkçe
Siz süzme işlemi, A: D arasında 4 satırda da aynı anda şart sağlarsa mı yapmak istiyorsunuz.
 

Ömer

Moderatör
Yönetici
Katılım
18 Ağustos 2007
Mesajlar
21,424
Excel Vers. ve Dili
2016-Türkçe
Deneyiniz.
Kod:
Private Sub Worksheet_Change(ByVal Target As Range)

    Dim c As Range, ara, i As Byte
    
    If Intersect(Target, Range("B1")) Is Nothing Then Exit Sub
  
    If ActiveSheet.FilterMode = True Then
        ActiveSheet.ShowAllData
    End If
    
    If Worksheets("Sheet1").Range("B1") = "" Then Exit Sub
  
    ara = Worksheets("Sheet1").Range("B1").Value
    
    For i = 1 To 4
        ActiveSheet.Range("A2:D35").AutoFilter Field:=i, Criteria1:="*" & ara & "*"
    Next i

End Sub
 
Katılım
27 Ekim 2020
Mesajlar
14
Excel Vers. ve Dili
Office 2019
Ömer bey 4 sütunda da arama yapıyor ama sonuçları göstermiyor.
 

Ömer

Moderatör
Yönetici
Katılım
18 Ağustos 2007
Mesajlar
21,424
Excel Vers. ve Dili
2016-Türkçe
Örnek dosya ekleyip çalışma içinde konuyu örnek vererek detaylı açıklayınız.

 

Ömer

Moderatör
Yönetici
Katılım
18 Ağustos 2007
Mesajlar
21,424
Excel Vers. ve Dili
2016-Türkçe
İstediğiniz türde filtreleme olmaz, satır gizleme yapılması gerekir. İstediğiniz filtreleme kullanarak yapabilmek için yardımcı sütun kullandırılıp şarta uyanlar ilgili sütuna yazdırılıp bu sütun filtre yaptırılabilir.

Satır gizleme ile yapılmış örnek:
Deneyiniz.
Kod:
Private Sub Worksheet_Change(ByVal Target As Range)

    Dim c As Range, Adr As String, i As Integer, s As Integer, dizi()

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

    Application.ScreenUpdating = False

    Rows("3:35").EntireRow.Hidden = False

    If Target = "" Then Exit Sub

    For i = 1 To 4
        Set c = Cells(3, i).Resize(35, 1).Find(Target, LookAt:=xlPart)
        If Not c Is Nothing Then
            Adr = c.Address
            Do
                ReDim Preserve dizi(s)
                dizi(s) = c.Row
                s = s + 1
                Set c = Cells(3, i).Resize(35, 1).FindNext(c)
            Loop While Not c Is Nothing And c.Address <> Adr
        End If
    Next i

    If s = 0 Then Exit Sub

    For i = 3 To 35
        If IsError(Application.Match(i, Application.Transpose(dizi), 0)) Then
            Rows(i).EntireRow.Hidden = True
        End If
    Next i

    Application.ScreenUpdating = True

End Sub
.
 

Ekli dosyalar

Katılım
27 Ekim 2020
Mesajlar
14
Excel Vers. ve Dili
Office 2019
Teşekkür ederim Ömer bey, bu şekilde daha iyi oldu.
 
Üst