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

dongfgdwdjg

jsgj2023 发表于 2016-8-1 22:19
增加匹配直辖市，匹配县，区分“区”和“小区”，详见附件。

谢谢！深夜了还劳心帮忙，您辛苦了。

dongfgdwdjg

gbgbxgb 发表于 2016-8-1 21:35
某些人玩正则玩上瘾了，有兴趣的琢磨下：
.Pattern = "^(([^省]+省)|(.+自治区))?([^市]+市)?([^市区县]+( ...

哈哈，老师，您真逗，“上个图片，不提供代码”，就是说，您只告诉我您会但不教我或不帮我，是吧？
我是求助贴，对您能不能我不是很在意，我更关心的是我能不能解决问题。
很理解您对自己知识成果的保护。祝您自娱自乐、开开心心！

jsgj2023

dongfgdwdjg 发表于 2016-8-2 08:11
谢谢！深夜了还劳心帮忙，您辛苦了。

gbgbxgb 这位老师已经给出更为准确的正则表达式，你只要在我的代码上稍加修改，应该就能达到你的需求了。

jsgj2023

再次修改。

dongfgdwdjg

jsgj2023 发表于 2016-8-2 08:27
gbgbxgb 这位老师已经给出更为准确的正则表达式，你只要在我的代码上稍加修改，应该就能达到你的需求了。

也就是说，gbgbxgb老师没给我帮上忙，但给你提供思路了？换句话说，我还是太菜了，不明白也不理解代码的真正意思，所以就用不上了。
再次谢谢您费心！

jsgj2023

dongfgdwdjg 发表于 2016-8-2 12:40
也就是说，gbgbxgb老师没给我帮上忙，但给你提供思路了？换句话说，我还是太菜了，不明白也不理解代码的 ...

加油学习，有时候老师不提供代码，只会激发你的学习欲望。半年前我也碰到过同样的情况，老师给出了演示动画，但未提供代码。我一直记着这事，所以下决心要学好VBA。

gbgbxgb

jsgj2023 发表于 2016-8-2 21:03
加油学习，有时候老师不提供代码，只会激发你的学习欲望。半年前我也碰到过同样的情况，老师给出了演示动 ...

谦虚好学，赞一个，下列代码供参考：
        Set reg = CreateObject("VBScript.RegExp")
        With reg
            .Pattern = "^(([^省]+省)|(.+自治区))?([^市]+市)?([^区县]+(市|[^小]区|县))?(.+(街道办事处|街道办|街道|[^小]镇|乡))?(.+)?"
            For i = 2 To UBound(arr)
                theStr = arr(i, 1)
                If theStr <> "" Then
                    Set theMatches = .Execute(theStr)
                    With theMatches(0)
                        For j = 0 To 8
                            theStr = .submatches(j)
                            Select Case j
                                Case 0
                                    If theStr <> "" Then
                                        brr(i - 1, 1) = theStr
                                    Else
                                        brr(i - 1, 1) = "山东省"
                                    End If
                                Case 3
                                    For k = 0 To UBound(a)
                                        If theStr = a(k) Then
                                            theProvinceYes = True
                                            Exit For
                                        End If
                                    Next k
                                    '
                                    If Not theProvinceYes Then
                                        brr(i - 1, 2) = theStr
                                    Else
                                        brr(i - 1, 1) = theStr
                                        theProvinceYes = False
                                    End If
                                Case 4
                                    brr(i - 1, 3) = theStr
                                Case 6
                                    brr(i - 1, 4) = theStr
                                Case 8
                                    brr(i - 1, 5) = theStr
                            End Select
                        Next j
                    End With
                End If
            Next i
        End With

事后补注：其中变体型变量a为 a = VBA.Array("北京市", "天津市", "上海市", "重庆市")

再注：
1.theProvinceYes是一逻辑变量，即定义Dim theProvinceYes as Boolean，该逻辑变量用于确定是否直辖市；
2.Select Case的结构效率不高，你若有兴趣，不嫌代码写的难看，那么改成If结构则其效率要高得多。


改了下，发现也不难看：
        arr = .Range(.Cells(1, 1), .Cells(theFinalRow, 1))
        ReDim brr(1 To UBound(arr) - 1, 1 To 5)
        a = VBA.Array("北京市", "天津市", "上海市", "重庆市")
        '
        Set reg = CreateObject("VBScript.RegExp")
        With reg
            .Pattern = "^(([^省]+省)|(.+自治区))?([^市]+市)?([^区县]+(市|[^小]区|县))?(.+(街道办事处|街道办|街道|[^小]镇|乡))?(.+)?"
            For i = 2 To UBound(arr)
                theStr = arr(i, 1)
                If theStr <> "" Then
                    Set theMatches = .Execute(theStr)
                    With theMatches(0)
                        For j = 0 To 8
                            theStr = .submatches(j)
                            If j = 0 Then
                                If theStr <> "" Then
                                    brr(i - 1, 1) = theStr
                                Else
                                    brr(i - 1, 1) = "山东省"
                                End If
                            ElseIf j = 3 Then
                                For k = 0 To UBound(a)
                                    If theStr = a(k) Then
                                        theProvinceYes = True
                                        Exit For
                                    End If
                                Next k
                                '
                                If Not theProvinceYes Then
                                    brr(i - 1, 2) = theStr
                                Else
                                    brr(i - 1, 1) = theStr
                                    theProvinceYes = False
                                End If
                            ElseIf j = 4 Then brr(i - 1, 3) = theStr
                            ElseIf j = 6 Then brr(i - 1, 4) = theStr
                            ElseIf j = 8 Then brr(i - 1, 5) = theStr
                            End If
                        Next j
                    End With
                End If
            Next i
        End With
        .Cells(2, 3).Resize(UBound(brr), UBound(brr, 2)) = brr

dongfgdwdjg

jsgj2023 发表于 2016-8-2 21:03
加油学习，有时候老师不提供代码，只会激发你的学习欲望。半年前我也碰到过同样的情况，老师给出了演示动 ...

哈哈，有相同的经历啊。十分感谢你的帮助和鼓励。

dongfgdwdjg

gbgbxgb 发表于 2016-8-2 21:30
谦虚好学，赞一个，下列代码供参考：
        Set reg = CreateObject("VBScript.RegExp")
        Wit ...

不明觉厉！先谢一个。
运行中出错，停在Brr(i - 1, 1) =这一句上，我不太明白，大约别人会明白。我再学习研究吧。

wuliu56

dongfgdwdjg 发表于 2016-8-2 12:40
也就是说，gbgbxgb老师没给我帮上忙，但给你提供思路了？换句话说，我还是太菜了，不明白也不理解代码的 ...

其实那位老师已经给出了最核心的东西，也就是正则表达式。你想要的效果最最主要的就是依靠正则表达式。其实这样不是能更好的激发你的学习动力么？干嘛说人家没帮上忙，人家也是为你这个问题出力了，只是你还没达到理解他答案的能力。虚心接受，方能成大气。