求一类似快递收件人信息拆分功能

西平_Haval

在网上参考了一类似快递app分拆地址 ，收件人，电话功能，但执行功能报错，大概是类型不符，小弟能力不够，不知错在哪里，请大神出招
Sub chaifen()

Dim ar, i%, br() As String

Dim reg As Object

Set reg = CreateObject("vbscript.regexp")

reg.Pattern = "\d{4}-\d+|\d{11}$"

ar = Range("a1", Cells(Rows.Count, 1).End(xlUp))

ReDim br(1 To UBound(ar), 1 To 2)

For i = 1 To UBound(ar)

    br(i, 2) = reg.Execute(ar(i, 1))(0)
    br(i, 1) = Replace(ar(i, 1), br(i, 2), "")
Next i

[b:c].Clear
[b1].Resize(UBound(br), 2) = br

End Sub

ykcbf1100

正则问题，简单改一下即可拆分地址和电话

dambcer

改下这个地方就好了

lushang2018

[\u4e00-\u9fa5]+，这个是汉字的正则，你把汉字提出来替换掉就剩下电话号码

西平_Haval

十分感谢群里回复 大神，祝大家元旦快乐，远离阳阳，但生活要阳光