如何拆分地址

liu-aguang

dyzx 发表于 2016-4-13 16:06
liu-aguang老师：就是要这个效果，如果现在拆分成省一列、市一列、县一列、区一列、镇一列，应该怎样修改 ...

1. Sub test()
   
2.     arr = Sheets("表1").Range("a1").CurrentRegion.Resize(, 8)
   
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.             For j = 0 To 3
    
11.                 arr(i, j + 5) = mh(0).submatches(j)
    
12.             Next
    
13.         End If
    
14.     Next
    
15.     Sheets("表2").Range("a1").Resize(UBound(arr), 8) = arr
    
16. End Sub
    

复制代码

dyzx

liu-aguang 发表于 2016-4-14 08:43

liu-aguang老师：如果拆分后都是不要“省、市、县、镇”这几个字，应该怎样修改代码，多谢指教

liu-aguang

dyzx 发表于 2016-4-14 16:32
liu-aguang老师：如果拆分后都是不要“省、市、县、镇”这几个字，应该怎样修改代码，多谢指教

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

复制代码

dyzx

liu-aguang 发表于 2016-4-14 19:01

liu-aguang老师：非常多谢你在百忙之中抽时间解答我的问题。

Cindy_Blue

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

高手，您的代码这代码写的真好，都不用参照查询参照表就直接可以拆分。只是我比较小白，看不懂，自己改不了，能不能请您帮忙再改一下~
1. 地址拆分后直接写入表格E列和F列
2. 点击地址分离，执行宏后，表格内其他单元格的内容和公式不会被清掉

Cindy_Blue

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

liu-aguang 老师，您这代码写的真好，只是我比较小白，看不懂也改不了。能不能请您再帮我调整下？
1. 我想把地址拆成省和市后直接放入E列和F列；
2. 我表格中F列后还有别的内容和公式，可不可以执行后，不影响别的单元格的内容和公式？

YZC51

Cindy_Blue 发表于 2019-1-18 17:52
liu-aguang 老师，您这代码写的真好，只是我比较小白，看不懂也改不了。能不能请您再帮我调整下？
1. 我 ...

请参考
Sub test()
    arr = Sheets("表1").Range("a1").CurrentRegion.Resize(, 6)
    Set regx = CreateObject("vbscript.regexp")
    For i = 2 To UBound(arr)
        If arr(i, 4) <> "" Then
            ar = Split(arr(i, 4), " ")
            If UBound(ar) > 0 Then s = ar(1) Else s = ar(0)
            regx.Pattern = "^([^市县区]+?[省区])|((?:北京|上海|天津|重庆)市?)(.*?[区县])"
            Set mh = regx.Execute(s)
            If mh.Count <> 0 Then
                arr(i, 5) = mh(0).submatches(0) & mh(0).submatches(1)
                arr(i, 6) = mh(0).submatches(2)
            Else
                arr(i, 5) = ""
            End If
            s = regx.Replace(s, "")
            regx.Pattern = "^.+?[市县区]"
            Set mh = regx.Execute(s)
            If mh.Count <> 0 Then arr(i, 6) = mh(0)
            s = regx.Replace(s, "")
            regx.Pattern = "^(.+?县)?(.+?[镇乡区])?"
            Set mh = regx.Execute(s)
            If mh.Count <> 0 Then
            '    If mh(0).submatches(0) <> "" Then _
                arr(i, 6) = mh(0).submatches(0) Else _
                arr(i, 6) = mh(0).submatches(1)
            End If
        End If
    Next
    Sheets("表1").Range("a1").Resize(UBound(arr), 6) = arr
End Sub

天蓝邪心

为啥我用这个老是内存溢出

lrh788

学习了！！！！

天蓝邪心

天蓝邪心 发表于 2019-1-28 10:49
为啥我用这个老是内存溢出

如果增加“路”，“街道”怎么写