excel - 使用各种分隔符将地址拆分为街道地址、城市、州、 zip 和国家

Question

我的数据在 Excel 中。我有几张数据，其中地址总是在每张纸的同一列中。地址格式的示例包括:
1155 15th Street NW Suite 600 Washington, DC 20005 US
4600 Emperor Blvd #200 Durham, NC 27703-8577 US
200 Stevens Drive 费城, PA 19113 US
505 City Parkway West Orange, CA 92868 US
550 S Caldwell St, Charlotte, NC 28202-2633 US
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

这是我得到的错误:
error_image

Answer 1

随着您的评论，有一个返回字符来描绘城市的街道地址，以及地址的常规范式: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