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

 

  • 0
    点赞
  • 4
    收藏
    觉得还不错? 一键收藏
  • 3
    评论

“相关推荐”对你有帮助么?

  • 非常没帮助
  • 没帮助
  • 一般
  • 有帮助
  • 非常有帮助
提交
评论 3
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值