Разделение адреса с различными разделителями на улицу, город, штат, почтовый индекс и страну

С вашим комментарием о том, что существует символ возврата для отделения адреса от города и обычный формат адресов: street|City, State Zip Country алгоритм становится намного проще, поскольку ряд Split функций может разделять части адреса.

Я также использовал оператор Type - не обязательно, но делает код более понятным, IMO. В зависимости от форматирования некоторые из операторов Trim могут не понадобиться, но они не повредят.

Обратите внимание, что вы можете изменить диапазоны / листы вашего источника данных и расположения результатов в соответствии с вашими конкретными требованиями.

РЕДАКТИРОВАТЬ: Я только что прочитал ваш комментарий о том, что может быть несколько returns перед обратным отправлением из города с почтового адреса.

Код для .street изменен соответственно

Option Explicit
Type Address
    street As String
    city As String
    state As String
    zip As String
    country As String
End Type
Sub splitAddresses()
    Dim wsSrc As Worksheet, wsRes As Worksheet, rRes As Range
    Dim vSrc As Variant, vRes As Variant
    Dim myAdr As Address
    Dim v, w, x, y
    Dim I As Long
    
Set wsSrc = Worksheets("sheet1")

'read into vba array for faster processing
With wsSrc
    vSrc = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp))
End With

Set wsRes = Worksheets("Sheet1")
    Set rRes = wsRes.Cells(1, 3)


ReDim vRes(0 To UBound(vSrc), 1 To 5)

'Headers
    vRes(0, 1) = "Street"
    vRes(0, 2) = "City"
    vRes(0, 3) = "State"
    vRes(0, 4) = "Zip"
    vRes(0, 5) = "Country"
    
For I = 1 To UBound(vSrc)
    v = Split(vSrc(I, 1), vbLf)
    With myAdr
        y = v
        ReDim Preserve y(UBound(y) - 1)
        .street = WorksheetFunction.Trim(Join(y, " "))

    w = Split(Trim(v(UBound(v))), ",")
        .city = w(0)
    
    x = Split(Trim(w(1)))
        .state = Trim(x(0))
        .zip = Trim(x(1))
        .country = Trim(x(2))
    
    vRes(I, 1) = .street
    vRes(I, 2) = .city
    vRes(I, 3) = .state
    vRes(I, 4) = .zip
    vRes(I, 5) = .country
End With

Set rRes = rRes.Resize(rowsize:=UBound(vRes, 1) + 1, columnsize:=UBound(vRes, 2))
With rRes
    .EntireColumn.Clear
    .Value = vRes
    .Rows(1).Font.Bold = True
    .Columns(4).NumberFormat = "@"
    .EntireColumn.AutoFit
End With
    
Next I

End Sub

В вашей логике разделения есть некоторые несоответствия, не считая того, что вам придется сравнивать массив улиц в верхнем регистре также со строковыми значениями Ucase().

Однако хорошие новости - поскольку вы, кажется, применяете последовательную логику адресации, то есть группируете город, штат + почтовый индекс вокруг последнего разделителя двоеточия, вы можете попробовать следующий код:

Option Explicit             ' declaration head of code module
Enum c                      ' define column constants
    [_Start] = 0
    add1
    City
    State
    Zip
End Enum

Sub SplitAddresses()
With Sheet1
    'define dataset
    Dim lastRow As Long: lastRow = .Range("A" & .Rows.Count).End(xlUp).Row
    Dim rng As Range: Set rng = .Range("A2:A" & lastRow)
    'assign to variant datafield array (provide for 4 columns: Add+City+State+ZIP)
    Dim v: v = rng.Resize(columnsize:=4).Value2
    'split data
    doSplit v
    'write split results to any target, e.g. B:B
    .Range("B2").Resize(UBound(v), 4) = v
End With
End Sub

Справочная процедура doSplit

Sub doSplit(data)
Dim i As Long
For i = LBound(data) To UBound(data)
    Dim curAddress As String: curAddress = data(i, c.add1)
    
    Dim tokens, tmp
    tokens = Split(curAddress, ",")
    
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    'a) analyze string part after last ","
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    tmp = Split(Trim(tokens(UBound(tokens))) & " ", " ", 2)
    'aa) add State + Zip (to columns 3..4)
    data(i, c.State) = tmp(0): data(i, c.Zip) = tmp(1)
    
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    'b) analyze first string part
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    tmp = Split(tokens(UBound(tokens) - 1), " ")
    'data(i, c.City) = tmp(UBound(tmp))   '<< only for 1-word city names
     data(i, c.City) = getCity(tmp)       '<< see edit below
    'bb) add City + Address
    data(i, c.add1) = Split(curAddress, data(i, c.City), 2)(0)
    data(i, c.add1) = Replace(data(i, c.add1), ",", "")
Next i
End Sub

Функция справки // Редактировать из-за комментария @ RonRosenfeld

Так как названия городов будут состоять из составных слов, присвоение строки города в приведенном выше подпункте должно быть изменено с data(r, c.City) = tmp(UBound(tmp)) на

    data(r, c.City) = getCity(tmp)  ' << function call

Функция getCity()

Включает проверки для common первых частей как «Север», «Запад» или «Новый», чтобы по крайней мере не проверять исчерпывающий список с составными названиями городов. Все остальные необходимые названия городов, содержащие более одного слова, необходимо указать в дополнительном списке cities:

Function getCity(tmp) As String
'Purp.: return valid city names of either one or two parts
'[1]Definitions
    'a) List common first parts of city names like "West" in "West Orange"
        Dim common$: common = "North,West,South,East,Grand,New"
    'b) List all other needed cities consisting of compound words
        Dim cities$: cities = "Sterling Heights,Ann Arbor"
'[2]Get potential city name
    'a) Define tmp indices of potential city tokens
        Dim first&: first = UBound(tmp) - 1
        Dim secnd&: secnd = UBound(tmp)
    'b) Build city name as compound string of tmp tokens
        Dim City As String
        City = Trim(IIf(first < 0, "", tmp(first) & " ") & tmp(secnd))
'[3]Check common first parts plus additional cities list
    'a) Check for common name parts like e.g. "West" in "West Orange"
        If InStr(common & ",", tmp(first) & ",") Then getCity = City: Exit Function
    'b) Check rest in listed cities and return function result
        getCity = IIf(InStr(cities, City) > 0, City, tmp(secnd))
End Function