Ответить

Ответить

Ответить

Ответить

Ответить

Ответить

Что-то посмотрел я на Quick Sort и мне показалось что этот метод только усугу[sensored]ет
положение т.к. кроме самого просмотра необходимо ещё и переставлять элементы набора,
 что скорости не прибавляет никак
Короче состряпал такую функцию

Public Function findFreeCode() As String
    Dim recCount As Integer, i As Integer, j As Integer
    Dim Min  As Double, FreeCode As Double
    Dim arr() As Double
    Adodc1.Recordset.MoveLast
    recCount = Adodc1.Recordset.RecordCount
    ReDim arr(recCount - 1) As Double ' определяем количество элементов в массиве
    Adodc1.Recordset.MoveFirst
    While Not Adodc1.Recordset.EOF 'заполнение массива кодами
        arr(Adodc1.Recordset.AbsolutePosition - 1) = CDbl(Adodc1.Recordset.Fields(0).Value)
        Adodc1.Recordset.MoveNext
    Wend
    Adodc1.Recordset.MoveFirst
    FreeCode = 0 'поиск свободного кода начиная с 1
lbl_reSearch:
    For i = 0 To recCount - 1 'просмотр массива на присутствие кода FreeCode +1
            If FreeCode + 1 = arr(i) Then ' если искомый код существует,
                FreeCode = arr(i) ' запоминаем его
                GoTo lbl_reSearch' ищем следующий
            End If
    Next i
    FreeCode = FreeCode + 1
    findFreeCode = PadToString(Trim$(Str(FreeCode)), 12)
End Function

И ещё будет ли такой вариант цикла работать быстрее(т.е. количество проходов меньше
в 10 раз, но за каждый проход проверяется 10 значений):

For i = 0 To recCount - 1 step 10  'просмотр массива на присутствие кода FreeCode +1...+10
 If FreeCode + 1 = arr(i) Then ' если искомый код существует,
                FreeCode = arr(i) ' запоминаем его
                GoTo lbl_reSearch' ищем следующий
        End If
 If FreeCode + 2 = arr(i) Then ' если искомый код существует,
                FreeCode = arr(i) ' запоминаем его
                GoTo lbl_reSearch' ищем следующий
        End If
 ...
 ...
  If FreeCode + 10 = arr(i) Then ' если искомый код существует,
                FreeCode = arr(i) ' запоминаем его
                GoTo lbl_reSearch' ищем следующий
        End If
    
Next i

Ответить

Ответить

Павел, спасибо что переслали сообщение. А быстрый поиск я реализовал, использовав метод RS.Sort  и вместо массива использовав переменную типа Variant, т.к. переменная заполняется очень быстро и без цикла, на что уходило немало времени. Может кому пригодится:

Private function Свободный_Номер() as Double
Dim i As Long
Dim varDataRows As Variant
RS.Sort = "Code" 'сортировка RS по полю "Код"    RS.MoveLast
    recCount = RS.RecordCount
    RS.MoveFirst
    varDataRows = RS.GetRows(recCount) ' делаем снимок со всего рекордсета сразу                           For i = 1 To recCount
        If i < CDbl(varDataRows(0, i - 1)) Then 'если условие верно, значит есть пропущеное в наборе кодов
            'обозначаем пропущеное как свободный номер 

           Свободный_Номер=i: Exit Function
        End If
    Next i
End Function

Помогло наличие RecordSet.Sort и нещадно ругаемая всеми переменная типаVariant. Результат-просмотр 50000 записей в самом неблагоприятном случае занимает ок.2сек. Спасибо всем.

Ответить