Field Koşulunu Değişken Yapmak

[Said ERSOY]

Merhabalar

Excelde bir adet tablom var A235 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.

 

[Said ERSOY]

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("A235").AutoFilter Field:=2, Criteria1:="*" & ara & "*"

End If
End Sub

 

[Ömer]

Merhaba,

Deneyiniz.

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

 

[Said ERSOY]

Ö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]

Siz süzme işlemi, A: D arasında 4 satırda da aynı anda şart sağlarsa mı yapmak istiyorsunuz.

 

[Said ERSOY]

Evet Ömer bey aynen öle

 

[Ömer]

Deneyiniz.

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

 

[Said ERSOY]

Ömer bey 4 sütunda da arama yapıyor ama sonuçları göstermiyor.

 

[Ömer]

Örnek dosya ekleyip çalışma içinde konuyu örnek vererek detaylı açıklayınız.

Dosya Yükle - Dosya Upload

Dosyalarınızı ücretsiz yükleyebilir ve paylaşabilirsiniz. Dosya yükleme, Dosya Upload ücretsiz.

dosya.co

 

[Said ERSOY]

Ömer Bey yükleme yaptım ve excel içerisine açıklamaları yazdım.


https://dosya.co/1xqk6i65rf23/arama_butonu_çalışması.xlsm.html

 

[Ömer]

İ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.

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

.

 

[Said ERSOY]

Teşekkür ederim Ömer bey, bu şekilde daha iyi oldu.