利用正则VBA拆分地址

原创

wx646c7bc9d1fe6 2023-05-26 15:04:16 ©著作权

文章标签 VBA 文章分类 代码人生

©著作权归作者所有：来自51CTO博客作者wx646c7bc9d1fe6的原创作品，请联系作者获取转载授权，否则将追究法律责任

拿到很多地址，需要把地址拆分为省市县，写了个VBA代码一键拆分。以备后用。

Sub test()
    Dim Reg, pts$(2), rpl$(2), ar, r&, i&, j&
    Set Reg = CreateObject("VBScript.RegExp")
    Reg.Global = True
    pts(0) = "^(河北|山西|辽宁|吉林|黑龙江|江苏|浙江|安徽|福建|江西|山东|河南|湖北|湖南|广东|海南|四川|贵州|云南|陕西|甘肃|青海|台湾)(?!省)"
    pts(1) = "^(内蒙古|广西|西藏|宁夏|新疆)(?!.*自治区)"
    pts(2) = "^((?:北京|天津|上海|重庆)市?|.+?(?:省|自治区))?(.+?(?:市|[^小社]区|自治州))?(.*?(?:[^小社院]区|[市县])(?![\)）]))?.*"
    rpl(0) = "$1省"
    rpl(1) = "$1自治区"
    rpl(2) = Replace("$1 $2 $3", " ", vbTab)
    r = Range("C65536").End(xlUp).Row
    ar = Range("C2").Resize(r)
    For j = 0 To 2
        Reg.Pattern = pts(j)
        For i = 1 To r - 1
            ar(i, 1) = Reg.Replace(ar(i, 1), rpl(j))
        Next
    Next
    With Range("E2").Resize(r)
        .Value = ar
        Application.DisplayAlerts = False
        .TextToColumns Tab:=True
    End With
End Sub