vba实现 Vlookup增强

请添加图片描述

出现错误名称,禁用了宏 “name”

=COMSPORT(table, valuecolmn, colmn)
table: 查询表,
valuecolmn:欲查询值,
colmn:欲查询列(在表中的某一列)

Function COMPFLOAT(table, value, search_col, return_col)


    Dim b As Variant
    Dim indexc As Integer
    
    tableV = table.Value2
    
    table_startrow = table.Row
    table_startcol = table.Column
    
    cells_col = return_col + table_startcol - 1
    
    len_table = UBound(tableV) - LBound(tableV) + 1

    Threshold = 0.002
    subvalue = Threshold
    '值相差最小的目标行
    '值相差最小的目标行
    For i = 1 To len_table
    
        cellsVal = tableV(i, search_col)
        
        If Abs(cellsVal - value) < subvalue Then
            subvalue = Abs(cellsVal - value)
            
            indexc = i
        
        End If
    
    Next

    If subvalue = Threshold Then
    
        COMPFLOAT = ""
    Else
    
        indexc = Int(indexc) + table_startrow - 1
    
        COMPFLOAT = Sheets(ActiveWindow.ActiveSheet.Name).Cells(indexc, cells_col)
 
    End If

End Function



字符串比较

Function COMPSTR(table, value, search_col, return_col)


    Dim b As Variant
    Dim indexc As Integer
    
    tableV = table.Value2
    
    table_startrow = table.Row
    table_startcol = table.Column
    
    len_table = UBound(tableV) - LBound(tableV)

    simmax = 0
    '值相差最小的目标行
    'aaa = sim("练市镇唐家庄路一期工程(练市镇2021-41号地块)", "练市镇唐家庄路期工程(")
    For i = 1 To len_table
        
        
        simv = sim(CStr(tableV(i, Val(search_col))), CStr(value))
        If simv > simmax Then
    
            simmax = simv
            
            indexc = i
        
        End If
    
    Next

    
    indexc = Int(indexc) + table_startrow - 1
    
    
  
 COMPSTR = Sheets(ActiveWindow.ActiveSheet.Name).Cells(indexc, return_col)
 
 
End Function



Private Function min(one As Integer, two As Integer, three As Integer)
    min = one
    If (two < min) Then
     min = two
    End If
    If (three < min) Then
     min = three
    End If
End Function
 
Private Function ld(str1 As String, str2 As String)
Dim n, m, i, j As Integer
Dim ch1, ch2 As String
    n = Len(str1)
    m = Len(str2)
    Dim temp As Integer
    If (n = 0) Then
        ld = m
    End If
    If (m = 0) Then
        ld = n
    End If
Dim d As Variant
ReDim d(n + 1, m + 1) As Variant
    For i = 0 To n
        d(i, 0) = i
    Next i
    For j = 0 To m
        d(0, j) = j
    Next j
    For i = 1 To n
        ch1 = Mid(str1, i, 1)
        For j = 1 To m
            ch2 = Mid(str2, j, 1)
            If (ch1 = ch2) Then
            temp = 0
            Else
                temp = 1
            End If
            d(i, j) = min(d(i - 1, j) + 1, d(i, j - 1) + 1, d(i - 1, j - 1) + temp)
        Next j
    Next i
    ld = d(n, m)
End Function
 
Public Function sim(str1 As String, str2 As String)
    Dim ldint As Integer
    ldint = ld(str1, str2)
    Dim strlen As Integer
    If (Len(str1) >= Len(str2)) Then
        strlen = Len(str1)
    Else
        strlen = Len(str2)
    End If
    sim = 1 - ldint / strlen
End Function




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

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

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

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

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

抵扣说明:

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

余额充值