我想从地址中提取邮政编码。我尝试了以下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
答案 0 :(得分:2)
我的意思是这样的:
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
使用正则表达式可能会更好。
答案 1 :(得分:1)
为补充@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
假设一个字符串中可能存在多个匹配项,则将使用最后一个匹配项。
如果您确定只有一场比赛(或没有一场比赛),那么您也可以使用:
If Matches.Count = 1 Then .Cells(x + 1, 2) = Matches.Item(0)
代替:
For Each Match In Matches
.Cells(x + 1, 2) = Match.Value
Next Match