Excel Vba Forum - Excelce.Net

SORU ve CEVAPLAR (Yazılabilir) => Microsoft Excel, Vba, Makro, Formül vb. Soruları => Çözülen Excel, Vba, Makro, Formül vb. Soruları => Konuyu başlatan: yyhy - 01 Eylül 2010, 15:19:05

Başlık: [Çözüldü] Hücre İçerisindeki Adresten Mah. Cad. Sok. Sit. ve No: Kısmını Aldırma
Gönderen: yyhy - 01 Eylül 2010, 15:19:05

Hücre İçerisindeki Adresten Mah. Cad. Sok. Sit. ve No: Kısmını Aldırabilir miyiz?

Başlık: Ynt: Hücre İçerisindeki Adresten Mah. Cad. Sok. Sit. ve No: Kısmını Aldırma
Gönderen: Bülent Öztürk - 01 Eylül 2010, 15:35:41

Makro ile çözüm işinize yarar mı?

Başlık: Ynt: Hücre İçerisindeki Adresten Mah. Cad. Sok. Sit. ve No: Kısmını Aldırma
Gönderen: yyhy - 01 Eylül 2010, 16:19:41

Eğer Adres İçerisinde Mah. Cad. Sok. Sit. ve No: kelimelerinden birisi olmadığı zaman önceki hücrelerde veya sonraki hücrelerde kopma olmasın istiyorum. Yani Şu şekilde açıklarsak; Hoca Cihan Mah. ( İçerisinde Cad. Yok ) Kibar Sok. Altan Sit. No:19/1 olarak aldırılabilir mi? Yani joker karekterler olmadığı zaman hücre değeri boş gözüksün önceki ve sonraki hücrelerin olması gereken bilgileri gelsin.

Başlık: Ynt: Hücre İçerisindeki Adresten Mah. Cad. Sok. Sit. ve No: Kısmını Aldırma
Gönderen: Bülent Öztürk - 01 Eylül 2010, 16:57:02

Boş bir modüle şu kodları ekleyin;

Kod: [Seç]

Public Function ExcelceAdres(adres As String, tip As Integer)
Application.Volatile
On Error Resume Next
bak_mahalle = InStr(1, adres, "Mah.", vbTextCompare)
bak_cadde = InStr(1, adres, "Cad.", vbTextCompare)
bak_sokak = InStr(1, adres, "Sok.", vbTextCompare)
bak_apartman = InStr(1, adres, "Apt.", vbTextCompare)
bak_no = InStr(1, adres, "No:", vbTextCompare)
bak_son = InStr(bak_no + 1, adres, " ", vbTextCompare)

If bak_mahalle > 0 Then bul_mahalle = VBA.Mid(adres, 1, bak_mahalle - 1): sonraki = bak_mahalle + 4 Else sonraki = 1: bul_mahalle = ""
If bak_cadde > 0 Then bul_cadde = VBA.Mid(adres, sonraki, bak_cadde - 1 - sonraki): sonraki = bak_cadde + 4 Else sonraki = sonraki: bul_cadde = ""
If bak_sokak > 0 Then bul_sokak = VBA.Mid(adres, sonraki, bak_sokak - 1 - sonraki): sonraki = bak_sokak + 4 Else sonraki = sonraki: bul_sokak = ""
If bak_apartman > 0 Then bul_apartman = VBA.Mid(adres, sonraki, bak_apartman - 1 - sonraki): sonraki = bak_apartman + 4 Else sonraki = sonraki: bak_apartman = ""
If bak_no > 0 Then bul_no = VBA.Mid(adres, bak_no + 3, bak_son - bak_no - 3) Else bul_no = ""

Select Case tip
    Case 1
    ExcelceAdres = Trim(bul_mahalle)
    Case 2
    ExcelceAdres = Trim(bul_cadde)
    Case 3
    ExcelceAdres = Trim(bul_sokak)
    Case 4
    ExcelceAdres = Trim(bul_apartman)
    Case 5
    ExcelceAdres = Trim(bul_no)
    Case Else
    ExcelceAdres = ""
End Select

End Function
Kullanımı:

Mahalle için:
=ExcelceAdres(B4;1)

Cadde için:
=ExcelceAdres(B4;2)

Sokak için:
=ExcelceAdres(B4;3)

Apartman için:
=ExcelceAdres(B4;4)

No için:
=ExcelceAdres(B4;5)


Dosyanızın düzenlenmiş hali ektedir.

[Forum yazılım güncelleme esnasında sorun oluştuğundan eklendi silinmiştir.]

Başlık: Ynt: Hücre İçerisindeki Adresten Mah. Cad. Sok. Sit. ve No: Kısmını Aldırma
Gönderen: yyhy - 01 Eylül 2010, 17:02:38

 :alkis Gerçekten Güzel Olmuş  :saygilar