VBA自动拆分地址

Function SplitAddress(split_value As String, address_array As Range, type_num As Integer)
    Dim startCol As Long '起始列号
    Dim endCol As Long '结束列号
    Dim startRow As Long '起始行号
    Dim endRow As Long '结束行号
    '获取匹配区域基本信息
    With address_array
        startCol = 1
        endCol = startCol + .Columns.Count - 1
        startRow = 1
        endRow = .Cells(.Rows.Count, startCol).End(xlUp).Row
        '函数执行
        Dim i As Long
        Dim j As Long
        Dim l As Long
        Dim addrCache As String '地址缓存
        Dim addrBack(3) '输出各级地址数组,0-省级;1-市级;2-区级;3-详细地址
        '   地址预处理
        Dim splitPoint
        splitPoint = Array("北京", "上海", "天津", "重庆")
        For i = 0 To UBound(splitPoint)
            If Len(Replace(Left(split_value, 8), splitPoint(i), "")) = 6 Then
                split_value = Left(split_value, 2) & split_value
                Exit For
            End If
        Next
        '   地址拆分
        '       省级单位拆分
        For i = 1 To endRow
            If .Cells(i, startCol) Like Left(split_value, 2) & "*" Then
                addrBack(0) = .Cells(i, startCol) '省级单位
                Exit For
            End If
        Next
        '       市级单位拆分
        For i = 8 To 1 Step -1
            addrCache = Replace(split_value, Left(addrBack(0), i), "", 1, 1)
            If Len(split_value) > Len(addrCache) Then
                split_value = addrCache
                For j = 1 To endRow
                    If .Cells(j, startCol) & .Cells(j, startCol + 1) Like addrBack(0) & Left(split_value, 2) & "*" Then
                        addrBack(1) = .Cells(j, startCol + 1) '市级单位
                        Exit For
                    End If
                Next
                Exit For
            End If
        Next
        '       区级单位拆分
        Dim addrPoint As String
        For i = 11 To 1 Step -1
            addrCache = Replace(split_value, Left(addrBack(1), i), "", 1, 1)
            If Len(split_value) > Len(addrCache) Then
                split_value = addrCache
                For j = 1 To endRow
                    If .Cells(j, startCol) & .Cells(j, startCol + 1) & .Cells(j, startCol + 2) Like addrBack(0) & addrBack(1) & Left(split_value, 2) & "*" Then
                        addrBack(2) = .Cells(j, startCol + 2) '区级单位
                        Exit For
                    End If
                Next
                Exit For
            End If
        Next
        '       详细地址返回
        For i = 15 To 1 Step -1
            addrCache = Replace(split_value, Left(addrBack(2), i), "", 1, 1)
            If Len(split_value) > Len(addrCache) Then
                addrBack(3) = addrCache
                Exit For
            End If
        Next
    End With
    SplitAddress = addrBack(type_num)
End Function

猜你喜欢

转载自blog.csdn.net/qq_18301257/article/details/81270282
vba