将带有各种分隔符的地址拆分为街道地址、城市、州、邮政编码和国家/地区

我的数据在 Excel 中。我有几张数据，其中地址始终位于每张数据的同一列中。地址格式的示例包括：

1155 15th Street NW Suite 600 华盛顿特区 20005 美国
4600 Empire Blvd #200 达勒姆, NC 27703-8577 US
200 Stevens Drive 费城, PA 19113 US
505 City Parkway 西奥兰治, CA 92868 美国
550 S Caldwell St，夏洛特，北卡罗来纳州 28202-2633 美国
1643 NW 136th Ave Ste H200 Sunrise, FL 33323-2857 US

我已经尝试了下面的代码，但此时代码“sCity = Trim(Mid$(rCell.Value, Len(sAddress) + 1, lStatePos - Len(sAddress) - 1))”中出现错误

谁能帮我弄清楚如何解决这个问题？

Sub SplitAddresses()

    Dim vaStates As Variant
    Dim vaStreets As Variant
    Dim i As Long
    Dim rCell As Range
    Dim sAddress As String
    Dim sCity As String, sState As String
    Dim sZip As String
    Dim lStreetPos As Long, lStatePos As Long

    vaStates = Array(“ AL “, “ AK “, “ AZ “, “ AR “, “ CA “, “ CO “, “ CT “, “ DE “, “ DC “, “ FL “, “ GA “, “ HI “, “ ID “, “ IL “, “ IN “, “ IA “, “ KS “, “ KY “, “ LA “, “ ME “, “ MD “, “ MA “, “ MI “, “ MN “, “ MS “, “ MO “, “ MT “, “ NE “, “ NV “, “ NH “, “ NJ “, “ NM “, “ NY “, “ NC “, “ ND “, “ OH “, “ OK “, “ OR “, “ PA “, “ RI “, “ SC “, “ SD “, “ TN “, “ TX “, “ UT “, “ VT “, “ VA “, “ WA “, “ WV “, “ WI “, “ WY “, “ GU “, “ PR “)
    vaStreets = Array(" CR ", " BLVD ", " RD ", " ST ", " AVE ", " CT ")

    For Each rCell In Sheet1.Range("A1:A5").Cells
        sAddress = "": sCity = "": sZip = "": sState = ""
        For i = LBound(vaStreets) To UBound(vaStreets)
            lStreetPos = InStr(1, rCell.Value, vaStreets(i))
            If lStreetPos > 0 Then
                sAddress = Trim(Left$(rCell.Value, lStreetPos + Len(vaStreets(i)) - 1))
                Exit For
            End If
        Next i

        For i = LBound(vaStates) To UBound(vaStates)
            lStatePos = InStr(1, rCell.Value, vaStates(i))
            If lStatePos > 0 Then
                sCity = Trim(Mid$(rCell.Value, Len(sAddress) + 1, lStatePos - Len(sAddress) - 1))
                sState = Trim(Mid$(rCell.Value, lStatePos + 1, Len(vaStates(i)) - 1))
                sZip = Trim(Mid$(rCell.Value, lStatePos + Len(vaStates(i)), Len(rCell.Value)))
                Exit For
            End If
        Next i

        rCell.Offset(0, 1).Value = "'" & sAddress
        rCell.Offset(0, 2).Value = "'" & sCity
        rCell.Offset(0, 3).Value = "'" & sState
        rCell.Offset(0, 4).Value = "'" & sZip

    Next rCell

End Sub

这是我得到的错误：错误图像 https://i.stack.imgur.com/PYnMt.png

根据您的评论，有一个回车字符可以从城市中描述街道地址，以及地址的常规格式：street|City, State Zip Country该算法变得更加简单，因为一系列Split函数可以分隔地址部分。

我也用过一个Type声明——不是必需的，但使代码更清晰，IMO。 根据格式的不同，有些Trim声明可能没有必要，但不会造成伤害。

请注意，您可以更改数据源和结果位置的范围/工作表以满足您的特定要求。

EDIT:我刚刚读到你的评论，可能有多个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