Hücre içindeki metni sıralama

[BBBBuRaKKKK]

Merhabalar,

Hücre içinde verilen karışık olan adresi sırasıyla mahalle, sokak ya da cadde, no, ilçe ve merkez olarak sıralama yapmamız mümkün mü?
Ekte ayrıntılı gösterilmiştir.

 

[Korhan Ayhan]

Merhaba,

Bu işlem için bir KTF hazırladım. (Kullanıcı Tanımlı Fonksiyon)

Hücrede kullanım şekli ; =SORT_BY_TEXT(A1)

Paylaştığınız örnek dosyadaki adreslere göre tanımladığım için genel kullanımda bazı adreslerde tam sonuç vermeyebilir. Uyguladığım dosyada ektedir. Özellikle birden fazla isimli sokak, mahalle, cadde isimlerinde sorun çıkaracaktır. Fikir vermesi açısından paylaşıyorum.

Option Explicit
Option Compare Text

Function SORT_BY_TEXT(Rng As String)
    Dim My_Text As String, My_Data As Object
    Dim Text As Object, Sorting_List As Variant
    
    Application.Volatile True
    
    My_Text = Replace(Replace(Replace(Rng, " : ", ":"), " :", ":"), ": ", ":")
    My_Text = Replace(Replace(Replace(My_Text, " / ", "/"), " /", "/"), "/ ", "/")
    
    ReDim Sorting_List(1 To 4)
    
    With CreateObject("VBScript.Regexp")
        .Pattern = "(\S+ MAH.)|(\S+ SOK.)|(\S+ CAD.)|(NO:\d+\/\d+)|(\S+)"
        .Global = True
        .IgnoreCase = True
        Set My_Data = .Execute(My_Text)
        For Each Text In My_Data
            If InStr(1, Text.Value, "MAH.") > 0 Then
                Sorting_List(1) = Text.Value
            ElseIf InStr(1, Text.Value, "CAD.") > 0 Or InStr(1, Text.Value, "SOK.") > 0 Then
                Sorting_List(2) = Text.Value
            ElseIf InStr(1, Text.Value, "NO:") > 0 Then
                Sorting_List(3) = Text.Value
            ElseIf InStr(1, Text.Value, "/") > 0 Then
                Sorting_List(4) = Text.Value
            End If
        Next
        Set My_Data = Nothing
    End With
    
    SORT_BY_TEXT = Join(Sorting_List, " ")
    
    Erase Sorting_List
End Function

 

[Haluk]

Alternatif dosya ektedir;


.

 

[BBBBuRaKKKK]

Ellerinize sağlık çok teşekkür ederim.