Option Explicit

Function MyAddress(rng As Range, Optional entry% = 0) As String
'' Author:  boa
'' Written: 09.07.2018
'  Description: возвращает строку адреса _
                entry - числовой параметр от 0 до 4 возвращаемой строки _
                0 -полный адрес _
                1 - индекс _
                2 - Страна _
                3 - населенный пункт/область _
                4 - улица, дом, кв и.т.д.
                

Dim MyArr$(), TempArr(1 To 4), i&, j&, str$
    MyArr = Split(rng.Text, ",")
    
Dim ArrAddress()    ' массив аббревиатур встречающихся в адресе
ArrAddress = Array(" ул.", " пр.", " пер.", " проспект", " кв.", " дом", " д ", " д.", " оф.", " офис", " корпус")

For i = LBound(MyArr) To UBound(MyArr)
    Select Case True
        Case i = 0 And IsNumeric(MyArr(i)):                         j = 1
        Case Trim(MyArr(i)) = "Россия":                             j = 2
        Case Contains(MyArr(i), ArrAddress) Or IsNumeric(MyArr(i)): j = 4
        Case Else:                    j = 3
    End Select
    
    TempArr(j) = IIf(Len(TempArr(j)) > 0, TempArr(j) & ", ", "") & Trim(MyArr(i))
Next
'    If IsEmpty(TempArr(2)) Then TempArr(2) = "Россия"
    If entry = 0 Then
        For i = 1 To 4
            If Len(TempArr(i)) > 0 Then
                str = str & IIf(Len(str) > 0, ", ", "") & TempArr(i)
            End If
        Next
        MyAddress = str
    Else
        MyAddress = TempArr(entry)
    End If

End Function

Function Contains(String1$, ArrString As Variant, Optional Start% = 1, _
        Optional compare As VbCompareMethod = vbTextCompare) As Boolean
    ' функция проверки вхождения значения из массива ArrString в строке String1 без учёта регистра
    Dim findPosition%, i&
    Contains = False
    For i = LBound(ArrString) To UBound(ArrString)
        findPosition = InStr(Start, String1, ArrString(i), compare)
        If findPosition >= Start Then Contains = True: Exit Function
    Next i
End Function