[已解决]正则--求匹配地址的改良代码

lingyuncelia1

Sub yy()
Dim brr(1 To 10000, 1 To 5)
arr = [a1].CurrentRegion
  Set regx = CreateObject("vbscript.regexp")
        regx.Pattern = "(.*省)(.*市)(.*)"
For i = 1 To UBound(arr)
        Set mh = regx.Execute(arr(i, 1))
        If mh.Count <> 0 Then
        A = A + 1
            For j = 0 To mh(0).submatches.Count - 1
                brr(A, j + 1) = mh(0).submatches(j)
            Next
        End If
    Next
    Range("b1").Resize(UBound(arr), 5) = brr
End Sub
运行以上代码，效果如下：

因为“广西壮族自治区南宁市青秀区东葛路135号D栋2单元1103号”不含省，
导致右边不出数据，且左右数据不对称。其实，我就是想改一下代码，将地址按省、市、区、街镇、村居、后续详细地址这样划分，
如果实在不能划分，空格显示也好，起码左右两边数据对称。

最佳答案

月排行榜 / 总排行榜

gufengaoyue

2016-8-31 15:29

lingyuncelia1 发表于 2016-8-31 14:57
谢谢，比较有效，但第12条，“办事处”是街镇级别吧，

这些原始数据本来都有多少缺漏，例如：湖北省应 ...

1. .Pattern = "(.*省|.*自治区)(.{1,4}市|.*自治州)?(.{1,4}[市区县])?(.{1,4}[镇乡]|.{1,4}办事处)?(.*)"

复制代码

跳转到最佳答案楼层

gufengaoyue

按这顺序来的
省/自治区，地级市，区/县级市/县，镇/乡，村/路/...

1. Sub yy()
   
2. Dim brr, arr
   
3. arr = [a1].CurrentRegion
   
4. brr = [b1].Resize(UBound(arr), 5)
   
5.     With CreateObject("vbscript.regexp")
   
6.         .Pattern = "(.*省|.*自治区)(.{1,4}市|.*自治州)?(.{1,4}[市区县])?(.{1,4}[镇乡])?(.*)"
   
7.         For i = 1 To UBound(arr)
   
8.             Set mh = .Execute(arr(i, 1))
   
9.             If mh.Count <> 0 Then
   
10.                 For j = 0 To mh(0).submatches.Count - 1
    
11.                     brr(i, j + 1) = mh(0).submatches(j)
    
12.                 Next
    
13.             End If
    
14.         Next
    
15.     End With
    
16. [b1].Resize(i - 1, 5) = brr
    
17. End Sub

复制代码

lingyuncelia1

gufengaoyue 发表于 2016-8-31 11:54
按这顺序来的
省/自治区，地级市，区/县级市/县，镇/乡，村/路/...

谢谢，比较有效，但第12条，“办事处”是街镇级别吧，

这些原始数据本来都有多少缺漏，例如：湖北省应城市城北办事处魏河村，其实应该是
湖北省-孝感市-应城市-城北办事处-魏河村

gufengaoyue

lingyuncelia1 发表于 2016-8-31 14:57
谢谢，比较有效，但第12条，“办事处”是街镇级别吧，

这些原始数据本来都有多少缺漏，例如：湖北省应 ...

1. .Pattern = "(.*省|.*自治区)(.{1,4}市|.*自治州)?(.{1,4}[市区县])?(.{1,4}[镇乡]|.{1,4}办事处)?(.*)"

复制代码