Belli Bir sütunda hücrelere girilen adres verisini değiştirme

[u.L.a.s]

C sütununda her satırda hücrelere adres verisi giriyorum.

"xxx mahallesi yyy caddesi zzz sokak ddd bulvarı" gibi

Ben bu adres verisini kısaltmak istiyorum

Örneğin
C5 e adresi yazdım veya adres verisini yapıştırdım.enter tuşuna bastığımda o hücreye yazdığım veride
mahallesi veya mahalle gördüyse mah.
sokak yazılıysa sok.
caddesi veya cadde yazılıysa cad.
bulvar veya bulvarı yazılıysa blv. şeklinde düzelmesini istiyorum

yani
"xxx mahallesi yyy caddesi zzz sokak ddd bulvarı"

olarak girdiğim adres
""xxx mah. yyy cad. zzz sok. ddd blv." olarak düzelmiş olacak.

Tabi mahalle cadde sokak bulvar verisi görmediyse bir düzeltme yapmayacak. veride varolan ve düzelmesi gerekenler düzelmiş olacak

Bilgi ve yardımlarınızı rica ederim

 

[ÖmerBey]

Merhaba,
Aşağıdaki makro kodunu deneyiniz...

Sub KOD()
bul = Array("mahalle", "cadde", "sokak", "bulvar")
deg = Array("mah.", "cad.", "sok.", "blv.")

For a = 2 To Range("C65500").End(3).Row
    metin = Split(Cells(a, "C").Value, " ")
    For b = LBound(metin) To UBound(metin)
        For c = LBound(bul) To UBound(bul)
            If InStr(1, metin(b), bul(c)) = 1 Then
                metin(b) = deg(c)
                Exit For
            End If
        Next
    Next
    Cells(a, "C").Value = Join(metin, " ")
Next
End Sub

Bul değişkeniyle başlayan kelimeleri deg değişkeniyle değiştirir.

 

[u.L.a.s]

Kod güzel ama büyük küçük harf duyarı var.

burada mahalle arıyor. eğer hücrede Mahalle yazıyorsa değiştirmiyor.

ayrıca sadece mahalle değil veride mahallesi de geçebilir. onuda mah. olarak değiştirebilmeli

Yani bul ve deg değerleri şu şekilde olmalı
"mahalle","mahallesi" = "mah."
"caddesi","cadde" = "cad."
"bulvarı","bulvar" = "blv."

 

[ÖmerBey]

Büyük küçük harf duyarlılığı olmaması için aşağıdaki değişikliği yapınız.

Sub KOD()
bul = Array("mahalle", "cadde", "sokak", "bulvar")
deg = Array("mah.", "cad.", "sok.", "blv.")

For a = 2 To Range("C65500").End(3).Row
    metin = Split(Cells(a, "C").Value, " ")
    For b = LBound(metin) To UBound(metin)
        For c = LBound(bul) To UBound(bul)
            If InStr(1, metin(b), bul(c)[COLOR="Red"], vbTextCompare[/COLOR]) = 1 Then
                metin(b) = deg(c)
                Exit For
            End If
        Next
    Next
    Cells(a, "C").Value = Join(metin, " ")
Next
End Sub

Yukarıda belirttiğim gibi "bul" değişkeniyle başlayan kelimeleri değiştirir. Yani mahalle belirtilmişse mahalle ile başlayan bütün kelimeler değişir. Ancak sokak dediğiniz zaman "sokağı" kelimesi değişmez. Çünkü; k yumuşadığı için bu kelime sokak ile başlamıyor. Bu problemi de bul ve deg değişkenlerine yeni veriler ekleyerek çözebilirsiniz.
İyi çalışmalar...

 

[u.L.a.s]

Bu şekilde değiştirdim. zaten hem mahalle hemde mahallesi diye eklediğimde hata veriyor kod.

bul = Array("mahallesi", "caddesi", "sokak", "bulvarı")
deg = Array("mah.", "cad.", "sok.", "blv.")

Peki bunu bir butona atamak yerine ben bu listeye zaten hergün 5-6 tane veri giriyorum sürekli. ben her seferinde bu kodu çalıştırmak yerine veri girdiğim hücre o an girdiğimde değiştirse olmuyor mu.

C2551 e adres verisini yazdığımda yada bir yerden kopyala yapıştır yaptığımda enter basında o girdiğim verideki bu değerler değişsin

 

[ÖmerBey]

Bu değiştirdiğiniz şekliyle mahalle kelimesini değiştirmez, ama "mahalle" yazarsanız "mahallesi" kelimesini de değiştirir. Şöyle anlatayım yazdığınız adresteki bir kelime bul değerinden biriyle başlıyorsa değişim yapar.
Veri girdiğinizde değişmesi için de aşağıdaki kodu ilgili sayfanın kod bölümüne kopyalayıız.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("C:C")) Is Nothing Or Target.Cells.Count > 1 Then Exit Sub
Application.EnableEvents = False
bul = Array("mahalle", "cadde", "sokak", "bulvar")
deg = Array("mah.", "cad.", "sok.", "blv.")
metin = Split(Target.Value, " ")
For b = LBound(metin) To UBound(metin)
    For c = LBound(bul) To UBound(bul)
        If InStr(1, metin(b), bul(c), vbTextCompare) = 1 Then
            metin(b) = deg(c)
            Exit For
        End If
    Next
Next
Target.Value = Join(metin, " ")
Application.EnableEvents = True
End Sub

 

[u.L.a.s]

süper tamam şu an anlaıdm izah ettiğiniz durumu.

ve bu kodla çok güzel oldu emeğinize bilginize sağlık üstadım çok teşekkür ederim