Function fnBinarySearch( _
  varItems As Variant, _
  varFound As Variant) As Integer
  
    Dim intLower As Integer
    Dim intMiddle As Integer
    Dim intUpper As Integer
    
    intLower = LBound(varItems)
    intUpper = UBound(varItems)
    
    Do While intLower < intUpper
        intMiddle = (intLower + intUpper) \  2 
        
        If varFound > varItems(intMiddle) Then
            intLower = intMiddle +  1 
        Else
            intUpper = intMiddle
        End If
    Loop
    
    If varItems(intLower) = varFound Then
        fnBinarySearch = intLower
    Else
        fnBinarySearch = - 1 
    End If
End Function

Sub Test()
    Dim avarItems( 4 ) As Variant
    Dim intPos As Integer

    avarItems( 0 ) = "ААА"
    avarItems( 1 ) = "БББ"
    avarItems( 2 ) = "ВВВ"
    avarItems( 3 ) = "ГГГ"
    avarItems( 4 ) = "ДДД"
    
    intPos = fnBinarySearch(avarItems, "ДДД")
    
    If intPos = - 1  Then
        Debug.Print "Соответствий не найдено."
    Else
        Debug.Print avarItems(intPos); " найден в позиции"; intPos
    End If
End Sub