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

dongfgdwdjg · 发表于 2016-8-1 08:38

我公司员工居住地址比较混乱，现在要标准化一下信息，把一列居住地址拆分为省市、地市、县市区、乡镇街道办、具体地址等五列，拆分后效果如图。在附件里，我写了一下拆分思路，但不是绝对要求，只要能达到目的，不按那个思路编代码也可以。
请大师们看一下，能否实现？

jsgj2023 · 发表于 2016-8-1 09:50

谁能给出正确的正则表达式吗？

jsgj2023 · 发表于 2016-8-1 10:20

Option Explicit
Sub 拆分家庭住址()
Dim Reg, Mat, Ma, x&, arr2(1 To 10000, 1 To 5), k&
Dim R&, Arr, Brr, i&, a&
Application.ScreenUpdating = False
R = Cells(Rows.Count, 1).End(xlUp).Row
Arr = Range("a2:a" & R)
Set Reg = CreateObject("Vbscript.RegExp")
With Reg
.Global = True
.Pattern = "([ \u4e00-\u9fa5]+省)?([ \u4e00-\u9fa5]+市)?([ \u4e00-\u9fa5]*区)?([ \u4e00-\u9fa5]+镇|乡)?(\S+)"
End With
For i = 1 To UBound(Arr)
Set Mat = Reg.Execute(Arr(i, 1))
For Each Ma In Mat
For x = 1 To 5
arr2(i, x) = Reg.Replace(Ma, "$" & x)
Next x
Next Ma
Next i
[c:g].Clear
[D:D].NumberFormatLocal = "@"
[c1].Resize(1, 5) = Array("省市", "地市", "县市区", "乡镇街道办", "具体地址")
For a = 1 To UBound(arr2)
If arr2(a, 1) = "" Then
arr2(a, 1) = "山东省"
End If
Next a
[c2].Resize(i, 5) = arr2
Range("c:H").EntireColumn.AutoFit
Range("c1:g" & R).Borders.LineStyle = xlContinuous
Application.ScreenUpdating = True
End Sub

复制代码

jsgj2023 · 发表于 2016-8-1 10:22

详见附件。

johnwalk · 发表于 2016-8-1 10:23

其实不用正则自带函数就可以搞掂
find+len+left+mid+right
个别不对的手工改改就行

lujkhua · 发表于 2016-8-1 10:52

jsgj2023 发表于 2016-8-1 10:22
详见附件。

腻害！学习了！

dongfgdwdjg · 发表于 2016-8-1 12:42

jsgj2023 发表于 2016-8-1 10:22
详见附件。

也太厉害了，又快又好，太崇拜了。就这一个案例，也够我学习一阵了
谢谢jsgj2023 老师!

dongfgdwdjg · 发表于 2016-8-1 12:43

jsgj2023 发表于 2016-8-1 10:22
详见附件。

请问一下，如果要把县市区以后部分删除，代码应如何改动？就如附件“籍贯”工作表中要求的那样。

dongfgdwdjg · 发表于 2016-8-1 12:47

johnwalk 发表于 2016-8-1 10:23
其实不用正则自带函数就可以搞掂
find+len+left+mid+right
个别不对的手工改改就行

相当同意您的观点

dongfgdwdjg · 发表于 2016-8-1 12:48

johnwalk 发表于 2016-8-1 10:23
其实不用正则自带函数就可以搞掂
find+len+left+mid+right
个别不对的手工改改就行

您能否按您的思路另出一个解决方案？我想多学习学习！谢谢！！

		自动登录	找回密码
密码			免费注册

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