查找最接近的大于或等于范围内的数字

时间:2021-07-26 11:04:07

标签: excel vba

该函数在以下两种情况下都能完美运行:

  1. 在范围内查找最接近的数字
  2. 找到最接近的小于或等于范围内的数字

对于第三个条件,当我将函数调用到 find the closest value above your target 时,它返回 No value found,尽管值接近于该值且大于定义的目标。

Private Sub CommandButton1_Click()
    Output = TextBox1.Value
    MatchVlu = FindClosest(Range("I2:I32"), Output, 1)

    TextBox2 = MatchVlu
End Sub

Function FindClosest(ByVal rng As Range, Target As Variant, Optional Direction As Integer) As Variant
    'DESCRIPTION: Function returns the nearest value to a target
    'INPUT: Pass the function a range of cells, a target value that you want to find a number closest to
    ' and an optional direction variable described below.
    'OPTIONS: Set the optional variable Direction equal to 0 or blank to find the closest value
    ' Set equal to -1 to find the closest value below your target
    ' set equal to 1 to find the closest value above your target
    'OUTPUT: The output is the number in the range closest to your target value.
    ' Because the output is a variant, the address of the closest number can also be returned when
    ' calling this function from another VBA macro.
    t = 1.79769313486231E+308 'initialize
    FindClosest = "No value found"
    For Each r In rng
        If IsNumeric(r) Then
            u = Abs(r - Target)
            If Direction > 0 And r >= Target Then
                'only report if closer number is greater than the target
                If u < t Then
                    t = u
                    Set FindClosest = r
                End If
            ElseIf Direction < 0 And r <= Target Then
                'only report if closer number is less than the target
                If u < t Then
                    t = u
                    Set FindClosest = r
                End If
            ElseIf Direction = 0 Then
                If u < t Then
                    t = u
                    Set FindClosest = r
                End If
            End If
        End If
    Next
End Function

1 个答案:

答案 0 :(得分:0)

这对我有用:

Function FindClosest(ByVal rng As Range, Target As Variant, _
                     Optional Direction As Integer = 0) As Variant
    Dim t, r As Range, u, v, vl
    FindClosest = "No value found"
    For Each r In rng
        vl = r.Value
        'make sure numeric and not empty...
        If IsNumeric(vl) And Len(vl) > 0 Then
            u = r - Target
            v = Abs(u)
            If (Direction > 0 And u >= 0) Or _
               (Direction < 0 And u <= 0) Or _
                Direction = 0 Then
               
                If v < t Or IsEmpty(t) Then
                    t = v
                    Set FindClosest = r
                End If
            
            End If
        End If
    Next
End Function