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
VBA自动拆分地址
猜你喜欢
转载自blog.csdn.net/qq_18301257/article/details/81270282
今日推荐
周排行