包含家庭地址的单元格是否可以用VBA拆分

johnwalk

dongfgdwdjg 发表于 2016-8-1 16:48
不好意思，我没太弄明白。你的公式最终输出效果如图？还是哪个环节出了问题了？

呃，把显示公式的开关关掉就行了。
我的思路是用省、市、区、关键字作为截取字符串的依据，
关键点是截取长度
先截省再截市
为了少写判断条件，用了前序替换的方法
供参考

dongfgdwdjg

jsgj2023 发表于 2016-8-1 17:17
恩，这个情形我也发现了，因为是极个别的，所以就手工处理一下吧。

好的。 谢谢！

dongfgdwdjg

johnwalk 发表于 2016-8-1 17:38
呃，把显示公式的开关关掉就行了。
我的思路是用省、市、区、关键字作为截取字符串的依据，
关键点是截 ...

不好意思，显示公式的开关在什么地方。我太菜了

johnwalk

dongfgdwdjg 发表于 2016-8-1 17:55
不好意思，显示公式的开关在什么地方。我太菜了

好吧 找不到的话。。。。。
运行一下这一句：
    ActiveWindow.DisplayFormulas = False

dongfgdwdjg

johnwalk 发表于 2016-8-1 18:08
好吧 找不到的话。。。。。
运行一下这一句：
    ActiveWindow.DisplayFormulas = False

谢谢！ 解决了

dongfgdwdjg

楼上的大神们给予了很大帮助，但运行中还存在 一点瑕疵：如四个省级市（直辖市)不能识别、县不能识别，区和小区不分等。不知道还有没有 大师继续完善？先行谢过了。

yjh_27

省市区有对照表处理准确度才有基本保证。

gbgbxgb

某些人玩正则玩上瘾了，有兴趣的琢磨下：
.Pattern = "^(([^省]+省)|(.+自治区))?([^市]+市)?([^市区县]+(市|[^小]区|县))?(.+(街道办事处|街道办|街道|镇|乡))?(.+)?"

上个图片，不提供代码（附件仅是代码运行后的结果，即未含代码）：

jsgj2023

1. Option Explicit
   
2. 
   
3. Sub 拆分家庭住址()
   
4.     Dim Reg, Mat, Ma, x&, arr2(1 To 10000, 1 To 3)
   
5.     Dim R&, Arr, Brr, i&, a&, b%
   
6.     Application.ScreenUpdating = False
   
7.     R = Cells(Rows.Count, 1).End(xlUp).Row
   
8.     Arr = Range("a2:a" & R)
   
9.     Brr = Array("天津市", "北京市", "重庆市", "上海市")
   
10.     Set Reg = CreateObject("Vbscript.RegExp")
    
11.     With Reg
    
12.         .Global = True
    
13.         .Pattern = "([\u4e00-\u9fa5]*省)?([\u4e00-\u9fa5]*[市县])?([\u4e00-\u9fa5]{1,2}[县|市|区])"
    
14.     End With
    
15.     For i = 1 To UBound(Arr)
    
16.             Set Mat = Reg.Execute(Arr(i, 1))
    
17.             For Each Ma In Mat
    
18.                 For x = 1 To 3
    
19.                     arr2(i, x) = Reg.Replace(Ma, "$" & x)
    
20.                 Next x
    
21.             Next Ma
    
22.         Next i
    
23.     [c:e].Clear
    
24.     [c1].Resize(1, 3) = Array("省市", "地市", "县市区")
    
25.      For a = 1 To UBound(Arr)
    
26.         If arr2(a, 1) = "" Then
    
27.                 If arr2(a, 3) <> "天津市" And arr2(a, 3) <> "北京市" And arr2(a, 3) <> "上海市" And arr2(a, 3) <> "重庆市" Then
    
28.                     If arr2(a, 2) <> "天津市" And arr2(a, 2) <> "北京市" And arr2(a, 2) <> "上海市" And arr2(a, 2) <> "重庆市" Then
    
29.                         arr2(a, 1) = "山东省"
    
30.                     End If
    
31.                 End If
    
32.         End If
    
33.      Next a
    
34.     [c2].Resize(i, 3) = arr2
    
35.     Range("c:e").EntireColumn.AutoFit
    
36.     Range("c1:e" & R).Borders.LineStyle = xlContinuous
    
37.     Application.ScreenUpdating = True
    
38. End Sub
    

复制代码

jsgj2023

增加匹配直辖市，匹配县，区分“区”和“小区”，详见附件。