Строки + массив

Option Explicit
'
'   © Антихакер32™
'
'1. Дан ряд символов. Создать одномерный массив, элементами которого есть слова данной строки.
'2. Отсортировать массив по возрастанию.
'3. Организовать поиск в отсортированном массиве.
Dim j$()
 
Private Sub Form_Activate()
    Dim s$, f&, u&
    'Для примера берём какой-либо текст
    s = "Дан ряд символов. Создать одномерный массив, элементами которого есть слова данной строки."
    j = Split(LCase(s)): u = UBound(j) 'Разбиваем на слова
    qSort 0, u: Cls 'Быстро сотрируем и выводим отсортированный список
    For f = 0 To u: Print f & " " & j(f): Next
    Print
    Print "Ищем слово одномерный"
    f = Find("одномерный")
    Print "Находим " & f & " позицию в списке = [" & j(f) & "]"
End Sub
Public Function Find&(Elm$)
    Dim max&, f&
    max = UBound(j)
    For f = 0 To Log(max - 1) / Log(2) + 1
        Find = (Find + max) \ 2
        If Elm > j(Find) Then
            Find = Find + 1
        ElseIf Elm < j(Find) Then max = Find - 1
        Else: Exit Function
        End If
    Next
    Find = -1
End Function
Private Sub qSort(ByVal low As Long, ByVal high As Long)
    Dim I As Long, L As Long, M As String, wsp As String
    I = low: L = high: M = j((I + L) \ 2)
    Do Until I > L: Do While j(I) < M: I = I + 1: Loop: Do While j(L) > M: L = L - 1: Loop
        If (I <= L) Then wsp = j(I): j(I) = j(L): j(L) = wsp: I = I + 1: L = L - 1
    Loop
    If low < L Then qSort low, L
    If I < high Then qSort I, high
End Sub

Private Sub qSort(ByVal low As Long, ByVal high As Long)
    Dim I As Long, L As Long, M As String, wsp As String
    I = low: L = high: M = j((I + L) \ 2)
    Do Until I > L: Do While j(I) < M: I = I + 1: Loop: Do While j(L) > M: L = L - 1: Loop
        If (I <= L) Then wsp = j(I): j(I) = j(L): j(L) = wsp: I = I + 1: L = L - 1
    Loop
    If low < L Then qSort low, L
    If I < high Then qSort I, high
End Sub

Sub BinSearch(Arr() As String, Word As String, pos As Integer)
    A% = 1
    B% = UBound(Arr, 1)
    If Arr(A%) = Word Then
       pos = A%
       Exit Sub
    End If
    If Arr(B%) = Word Then
       pos = B%
       Exit Sub
    End If
    Do
       If Abs(A% - B%) <= 1 Then
          pos = -1
          Exit Sub
       End If
       C% = (A% + B%) / 2
       If Arr(C%) = Word Then
          pos = C%
          Exit Sub
       End If
       If Arr(C%) > Word Then
          B% = C%
       Else
          A% = C%
       End If
    Loop
End Sub
 
Sub Test_Search()
Dim X(1 To 10) As String
    X(1) = "aa"
    X(2) = "ab"
    X(3) = "ac"
    X(4) = "ad"
    X(5) = "ba"
    X(6) = "bb"
    X(7) = "bc"
    X(8) = "ca"
    X(9) = "cx"
    X(10) = "cy"
    BinSearch X, "bb", k%
    Debug.Print k%
    BinSearch X, "qq", k%
    Debug.Print k%
End Sub