正则--地址

Sub yy()
Dim brr(1 To 10000, 1 To 5)
arr = [a1].CurrentRegion
  Set regx = CreateObject("vbscript.regexp")
        regx.Pattern = "(\d{6})(.*省)(.*市)(.*)"
For i = 1 To UBound(arr)
        Set mh = regx.Execute(arr(i, 1))
        If mh.Count <> 0 Then
        A = A + 1
            For j = 0 To mh(0).submatches.Count - 1
                brr(A, j + 1) = mh(0).submatches(j)
            Next
        End If
    Next
    Sheets("B").Range("A2").Resize(UBound(arr), 5) = brr

End Sub