使用isNumeric从地址中提取邮政编码

Question

我想从地址中提取邮政编码。我尝试了下面的isNumeric方法从地址中提取6个数字。有些地址有5位数字，有些地址有6位邮政编码。但是有一些错误，有时11900仅显示1900，08000显示8000，并且还显示4位数字。

Range("A2").Select
i = 2
Do While ActiveCell <> ""
    Address = UCase(Trim(Range("C" & CStr(i))) + " " + Trim(Range("D" & CStr(i))) + " " + Trim(Range("E" & CStr(i))) + " " + Trim(Range("F" & CStr(i))))

    For p = 1 To Len(Address)
      If IsNumeric(Mid(Address , p, 6)) Then
         Range("O" & CStr(i)) = Mid(Address, p, 6)
      End If
    Next p

    ActiveCell.Offset(1, 0).Select
    i = i + 1
Loop

excel输出

Address                                                               Postal Code
Wisma Pansar, 23-27 Jln Bengkel P.O. Box 319, 96007 Sibu Sarawak        96007
Wisma Lim , Lot 50A, Sec. 92A, 3.1/2 Sg Besi, 57100 Kuala Lumpur        57100
No. 265A, Jalan Sungai Petani 08300 Gurun Kedah Darul Aman              8300
No. 39, Jalan Nipah, Taman Lip Sin 11900  Sungai Nibong Pulau Pinang    1900
4-G, Lebuh Sungai Pinang 1 Sri Pinang 11600 Jelutong Pulau Pinang       11600
539/2, Gypsum Metropolitan Tower, Rajthevee Bangkok 10400, Thailand     0400,
LOTS 1869 &1938, 18th MILE KAJANG, SEMENYIH ROAD SELANGOR D.E.          1938, *no postal code in address
36a, Joo Chiat Place, Singapore 427760                                  0

Answer 1

我的意思是这样的：

Sub test()
    Dim c As Range, p As Long, v, addr, i As Long, hit As Boolean

    Set c = Range("A2") 'no need to select the cell
    Do While c <> ""
        addr = c.Value 'using your examples
        hit = False
        For p = 1 To Len(addr)
            'will accept 5 or 6 digits - prefer 6
            ' so count down...
            For i = 6 To 5 Step -1
                v = Mid(addr, p, i)
                If v Like String(i, "#") Then
                    c.Offset(0, 1).NumberFormat = "@" 'in case of leading zero
                    c.Offset(0, 1).Value = v
                    hit = True
                    Exit For
                End If
            Next i
            If hit Then Exit For
        Next p
        Set c = c.Offset(1, 0)
    Loop
End Sub

正则表达式方法可能会更好。

Answer 2

为了补充@TimWilliams的回答，特此提出一个利用Array和Regular Expressions（后绑定）的解决方案。因此，让我们想象一下以下设置：

现在运行以下代码：

Sub Test()

Dim lr As Long, x As Long
Dim arr As Variant
Dim RegEx As Object: Set RegEx = CreateObject("vbscript.regexp")

'Set up regular expression
RegEx.Pattern = "\d{5,6}"
RegEx.Global = True

'Go through your data and execute RegEx
With Sheet1 'Change according to your sheets CodeName
    lr = .Cells(.Rows.Count, 1).End(xlUp).Row
    arr = .Range("A2:A" & lr).Value
    .Range("B2:B" & lr).NumberFormat = "@"
    For x = LBound(arr) To UBound(arr)
        Set Matches = RegEx.Execute(arr(x, 1))
        For Each Match In Matches
            .Cells(x + 1, 2) = Match.Value
        Next Match
    Next x
End With

End Sub