如何拆分地址

dyzx

将表1拆分成表2的格式，多谢老师指教，多谢

maditate

这个难度估计是很大的。

maditate

如果是肯字的   省  市  镇 这三个关键字还好办点，“省”字为界，“市”为界，“镇”字为界

liu-aguang

如果行政区域不带(省/市/县/区/镇),分离会发生错误.

1. Sub test()
   
2.     arr = Sheets("表1").Range("a1").CurrentRegion.Resize(, 6)
   
3.     Set regx = CreateObject("vbscript.regexp")
   
4.     For i = 2 To UBound(arr)
   
5.         If arr(i, 4) <> "" Then
   
6.             ar = Split(arr(i, 4), " ")
   
7.             If UBound(ar) > 0 Then s = ar(1) Else s = ar(0)
   
8.             regx.Pattern = "^([^市县区]+?[省区])|((?:北京|上海|天津|重庆)市?)(.*?[区县])"
   
9.             Set mh = regx.Execute(s)
   
10.             If mh.Count <> 0 Then
    
11.                 arr(i, 4) = mh(0).submatches(0) & mh(0).submatches(1)
    
12.                 arr(i, 5) = mh(0).submatches(2)
    
13.             Else
    
14.                 arr(i, 4) = ""
    
15.             End If
    
16.             s = regx.Replace(s, "")
    
17.             regx.Pattern = "^.+?[市县区]"
    
18.             Set mh = regx.Execute(s)
    
19.             If mh.Count <> 0 Then arr(i, 5) = mh(0)
    
20.             s = regx.Replace(s, "")
    
21.             regx.Pattern = "^(.+?县)?(.+?[镇乡区])?"
    
22.             Set mh = regx.Execute(s)
    
23.             If mh.Count <> 0 Then
    
24.                 If mh(0).submatches(0) <> "" Then _
    
25.                 arr(i, 6) = mh(0).submatches(0) Else _
    
26.                 arr(i, 6) = mh(0).submatches(1)
    
27.             End If
    
28.         End If
    
29.     Next
    
30.     Sheets("表2").Range("a1").Resize(UBound(arr), 6) = arr
    
31. End Sub
    

复制代码

liu-aguang

信息v1.rar (37.89 KB, 下载次数: 204)

2015-4-7 23:10 上传

点击文件名下载附件

dyzx

liu-aguang 发表于 2015-4-7 23:10

就是要这个效果，非常多谢liu-aguang老师。

tearsky621

正则用的正好~看不太懂就是。

dyzx

liu-aguang 发表于 2015-4-7 23:10

liu-aguang老师：如果拆分后不要“省、市、县、镇”这几个字，应该怎样修改代码，如广东   中山   南朗

liu-aguang

dyzx 发表于 2016-4-12 15:00
liu-aguang老师：如果拆分后不要“省、市、县、镇”这几个字，应该怎样修改代码，如广东   中山   南朗

1. Sub test()
   
2.     arr = Sheets("表1").Range("a1").CurrentRegion.Resize(, 6)
   
3.     Set regx = CreateObject("vbscript.regexp")
   
4.     For i = 2 To UBound(arr)
   
5.         If arr(i, 4) <> "" Then
   
6.             regx.Pattern = "[^ 一-龥]"
   
7.             arr(i, 4) = regx.Replace(arr(i, 4), "")
   
8.             ar = Split(Application.Trim(arr(i, 4)), " ")
   
9.             If UBound(ar) > 0 Then s = ar(1) Else s = ar(0)
   
10.             regx.Pattern = "^([^市县区]+?)省|(北京|上海|天津|重庆)市?|^([^市县区]+?区)"
    
11.             Set mh = regx.Execute(s)
    
12.             If mh.Count <> 0 Then
    
13.                 arr(i, 4) = mh(0).submatches(0) & mh(0).submatches(1) & mh(0).submatches(2)
    
14.             Else
    
15.                 arr(i, 4) = ""
    
16.             End If
    
17.             s = regx.Replace(s, "")
    
18.             regx.Pattern = "^(.县)|(.+?)[市县区]"
    
19.             Set mh = regx.Execute(s)
    
20.             If mh.Count <> 0 Then arr(i, 5) = mh(0).submatches(0) & mh(0).submatches(1)
    
21.             s = regx.Replace(s, "")
    
22.             regx.Pattern = "^(.县|.镇)|^(.+?)县|^([^区]+?)[镇乡]|^(.+?区)"
    
23.             Set mh = regx.Execute(s)
    
24.             If mh.Count <> 0 Then
    
25.                 If mh(0).submatches(0) <> "" Then
    
26.                 arr(i, 6) = mh(0).submatches(0)
    
27.                 ElseIf mh(0).submatches(1) <> "" Then
    
28.                 arr(i, 6) = mh(0).submatches(1)
    
29.                 Else
    
30.                 arr(i, 6) = IIf(mh(0).submatches(2) <> "", mh(0).submatches(2), mh(0).submatches(3))
    
31.                 End If
    
32.             End If
    
33.         End If
    
34.     Next
    
35.     Sheets("表2").Range("a1").Resize(UBound(arr), 6) = arr
    
36. End Sub
    

复制代码

dyzx

liu-aguang 发表于 2016-4-13 10:12

liu-aguang老师：就是要这个效果，如果现在拆分成省一列、市一列、县一列、区一列、镇一列，应该怎样修改代码，多谢指教。