Adres içerisinden belirli kelimeleri arama

[lipirta]

Merhaba arkadaşlar,

Bana bir formül kurmamda veya excel 2007 de uygun bir aramayı yapabilmemde yardımcı olursanız çok sevinirim.

Ekte bulunan örneğimin ilk sheet inde örnek bir data ve bu datanın ikinci sütununda adres yer almakta.İkinci sheetinde ise aradığım sokak ve mahalle isimleri yer almaktadır.

Benim yapmak istediğim işlem; adresi içerisinde aradığım sokak ve mahalle isimleri geçen müşterileri seçmek.Elimde 7500 müşteri no ve yaklaşık 300 aranan kelime olduğu için pratik bir filtreleme yolu arıyorum.

Yardımlarınızı bekliyorum,
Teşekkürler,

 

[Necdet]

Merhaba,

Basit düşünürek şöyle birşey yaptım :

E sütununa bir Veri doğrulama ekledim, buradan aradığınız sokağı seçebiliyorsunuz.

Seçtiğiniz sokağıda C sütununa aşağıdaki formülle aratarak bulduysa var, bulamadıysa yok ibaresini yazdırıp, Var olana göre süzdürünce aradığınız adresler listeleniyor.

=EĞER(EHATALIYSA(MBUL(" " & $E$1& " ";" "&B2&" "));"Yok";"Var")

 

[lipirta]

Hocam çok teşekkür ederim bu saatte yardımcı oldunuz.

Peki bu formüle göre benim tüm aranan kelimeleri tek tek aratmam mı gerekecek?Şu müşteri adresleri bu kelimelerden herhangi birini içeriyor şeklinde bir data filtrelemem gerekiyor.Bu şekilde 300 kelimeyi tek tek aratıp, müşterileri elle işaretlemem gerekecek.ya da ben mi yanlış anladım acaba, formülü kullanamamış olabilirim.

 

[Korhan Ayhan]

Merhaba,

Veri sayınız çok olduğu için ben alternatif makrolu çözüm öneriyorum. Ekteki dosyada butona tıkladığınızda uyan kelimeleri içeren adresler otomatik olarak süzülecektir.

İkinci sayfaya dilediğiniz kadar kelime yazabilirsiniz.


Uygulanan kod;

Option Explicit
 
Sub ADRES_ARA()
    Dim S1 As Worksheet, S2 As Worksheet
    Dim X As Long, BUL As Range, ADRES As String
    
    Application.ScreenUpdating = False
    
    Set S1 = Sheets("Sheet1")
    Set S2 = Sheets("Sheet2")
    
    On Error Resume Next
    S1.ShowAllData
    On Error GoTo 0
    
    S1.Range("C2:C" & Rows.Count).ClearContents
    
    For X = 2 To S2.Cells(Rows.Count, 1).End(3).Row
        Set BUL = S1.Range("B:B").Find(S2.Cells(X, 1), , , xlPart)
        If Not BUL Is Nothing Then
            ADRES = BUL.Address
            Do
                BUL.Offset(0, 1) = "X"
            Set BUL = S1.Range("B:B").FindNext(BUL)
            Loop While Not BUL Is Nothing And BUL.Address <> ADRES
        End If
    Next
 
    S1.Range("A1").AutoFilter Field:=3, Criteria1:="X"
    
    Set BUL = Nothing
    Set S1 = Nothing
    Set S2 = Nothing
 
    Application.ScreenUpdating = True
 
    MsgBox "Arama işlemi tamamlanmıştır.", vbInformation
End Sub

 

[lipirta]

Çok teşekkür ederim Hocam, macronuz hayatımı kurtardı diyebilirim
Elerinize sağlık,