Function ПерестановкаБукв(Str As String)
Dim n&, k&
Dim m
Dim i%
Dim Grad$, Bulvar$, Dom$
n = InStr(1, Str, "г.")
k = InStr(n + 2, Str, ",")
Grad = Mid(Str, n, k - n) & ", "
m = Array("ул.", "мкр.", "кв-л.", "б-р.", "проезд", "пр-кт", "пер.")
For i = LBound(m) To UBound(m)
    If InStr(k, Str, m(i)) Then
        n = k + 1
        k = InStr(n, Str, m(i)) - 1
        If n = k Then
            k = InStr(n, Str, ",")
            Bulvar = Mid(Str, n + 1, k - n - 1) & ", "
        Else
            Bulvar = m(i) & Mid(Str, n, k - n) & ", "
        End If
        
        Exit For
    End If
Next i
n = InStr(k, Str, "д.")
Dom = Trim(Mid(Str, n, Len(Str)))
ПерестановкаБукв = Grad & Bulvar & Dom
End Function

Function AVI(t As String) As String
AVI = t
    With CreateObject("VBScript.RegExp")
        .Pattern = "( )[^ ]+( ул\.| мкр\.| кв-л\.| б-р\.| проезд\.| пр-кт\.| пер\.), д"
        If .test(t) Then AVI = .Replace(t, Replace(Replace(.Execute(t)(0), .Execute(t)(0).submatches(1), ""), .Execute(t)(0).submatches(0), .Execute(t)(0).submatches(1) & " ", Count:=1))
    End With
End Function

Sub v_forme()
'/////
исходный_адрес = [a1]
исправленный_адрес = AVI(исходный_адрес)
[b1] = исправленный_адрес
'////
End Sub

Sub v_forme()
'/////
[b1].Value = AVI([a1].Value)
'////
End Sub

Function AVI(t As String) As String
AVI = t
    With CreateObject("VBScript.RegExp")
        .Pattern = "(, ).+( ул\.| мкр\.| кв-л\.| б-р\.| проезд\.| пр-кт\.| пер\.), д"
        If .test(t) Then AVI = .Replace(t, Replace(Replace(.Execute(t)(0), .Execute(t)(0).submatches(1), ""), .Execute(t)(0).submatches(0), "," & .Execute(t)(0).submatches(1) & " ", Count:=1))
    End With
End Function