“Счет на увеличение текста”

[Avtopic]

Здравствуйте!
Если можно получить совет: В базе сохраняются номера идентификатор документов, которые вводят вручную.
При вызове формы для создания нового документа происходит выборка из этой базы этих идентификаторов и заполняется
ComboBox4.

Код: Выделить всё

Set R = db.OpenRecordset("SELECT name, ID from obieqtebi order by updated DESC, created DESC;")
If R.RecordCount > 0 Then
R.MoveLast: R.MoveFirst
ComboBox4.Column = R.GetRows(R.RecordCount)
R.Close

А в TextBox1 заносится номер последнего документа

Код: Выделить всё

R = db.OpenRecordset("SELECT ID,Person from Docs Where DocDate=(SELECT max (DocDate) FROM Docs) AND DocTime=(SELECT max (DocTime) FROM Docs);")
If R.RecordCount > 0 Then Me.TextBox1 = R.Fields(0)

Как построить алгоритм того чтобы в TextBox1 текст получался номер последнего документа
1. +1 один если последний введений идентификатор заканчивался цифрой. (Пример: в случае “Док-00235” получать “Док-00236”)
2. следующий символ в алфавите, если последний введений идентификатор заканчивался не цифрой. (Пример: в случае “ННН-ТПА” получать “ ННН-ТПВ ”)
На первый взгляд это проще простого Mid(r.Fields(0), 1, Len(r.Fields(0)) - 1) & “следующий символ или цифра”
Но это не так просто и главная проблема связано
1. с переполнением то ест когда последний символ это последний в алфавите или 9 в цифрах.
2. длина идентификатора ограничено в 12 символов.
3. Уникальность идентификатора. То ест, новый идентификатор не должен совпадать со списком в ComboBox-е
Писал писал функцию для этого и получается очень длинный код. А между тем эта полезная услуга в очень многих программах реализовано. Вот и пишу в форум, может это как-то легко реализуется и я чего, то туплю - получил огромный код.

[alibek]

Помниться, в школе нас учили считать в столбик.
Т.е. складываешь последние разряды, если разряд переполняется, то записываешь последнюю цифру, а остальные переносишь на следующие разряды.
Почему бы тебе так и не сделать?

Что же касается того, что сгенерированный номер будет совпадать с уже существующим -- у тебя что, нумерация не сплошная? Т.е. могут быть номера 001, 002, 003, 008, 009, 013, 014?

Тут есть два решения. Попроще -- найти максимальный элемент и прибавить к нему один. Недостаток -- "дырки" в нумерации не будут заполняться.
Другой способ -- использовать свободные "дырки" в нумерации, если таковых нет, то последний элемент + 1. Но тут есть тонкости.
Как то мы со skiperski болтали на эту тему и даже придумали пару эффективных алгоритмов для работы с диапазонами.
Вот только в поиске его не нахожу, я это решение помоему на форум не постил.

[Avtopic]

Спасибо за ответ! Вы абсолютно точно поняли вопрос.

Нумерация не сплошная, произвольная. Ограничение только на длину (14 симв.) и допускаются символы только от Chr (65) до Chr(90) или от Chr (97) до Chr(122), “-“, и цифры. Эти ограничения контролирует счетчик или если вводят вручную, то контролирует TextBox при изменении.

Свободные "дырки" волнуют но, разумеется, на первом плане уникальность.
И упор делаю на последний идентификатор, так как его выбрал пользователь, и вероятнее всего, в этом формате текста идентификатора и будет продолжать вводить.

Т.е. складываешь последние разряды, если разряд переполняется, то записываешь последнюю цифру, а остальные переносишь на следующие разряды.
Почему бы тебе так и не сделать?

По-моему, более удобно реализовать, и сейчас попробую присобачить к моей задаче.

У меня сделано тупее: я разделяю идентификатор на Numeric и “не” Numeric” и “считаю” для всех отдельно. Доп.: имею последний идентификатор “ФАА-КВ-001-К02 ” делю на ФАА, КВ, 001, К и 02 и начиная с последнего считаю и если переполнение, то перехожу на предыдущий, но если Numeric то +1 а если и “не” Numeric” специальной счетчик с контролем вышеуказанных Chr.

[alibek]

Вот тебе автонумератор.
Автоматически понимает последовательности, состоящие из цифр, латинских букв, русских букв; смешивать их нельзя (т.е. ДОК001 не допустимо, ДОК-001 допустимо). Несколько последовательностей могут разделяться знаким тире.

Код: Выделить всё

Option Explicit

Public Function SerialGet(ByVal SValue As String, Optional ByVal Bits As String = "0123456789") As Long
Dim Base As Long, I As Long, P As Long, V As Long, res As Long
Base = Len(Bits)
If Base = 0& Then Exit Function
res = 0&
For I = 1 To Len(SValue)
  P = Len(SValue) - I
  V = InStr(Bits, Mid$(SValue, I, 1))
  If V > 0& Then
    res = res + (V - 1&) * (Base ^ P)
  End If
Next I
SerialGet = res
End Function

Public Function SerialLet(ByVal Value As Long, Optional PadSize As Long = 0, Optional ByVal Bits As String = "0123456789", Optional ByRef Overflow As String) As String
Dim Base As Long, P As Long, N As Long, I As Long, V As Long, res As String
Base = Len(Bits)
If Base = 0& Then Exit Function
If Value < 0& Then Exit Function
If Value = 0& Then
  If PadSize = 0 Then PadSize = 1
  SerialLet = String(PadSize, Left$(Bits, 1))
  Exit Function
End If
N = (Log(Value) / Log(Base))
res = vbNullString
For I = N To 0 Step -1
  P = Base ^ I
  V = Value \ P
  res = res & Mid$(Bits, V + 1, 1)
  If V > 0 Then Value = Value Mod P
Next I
Overflow = vbNullString
If PadSize > 0 Then
  If PadSize < Len(res) Then Overflow = Left$(res, Len(res) - PadSize)
  res = Right$(String(PadSize, Left$(Bits, 1)) & res, PadSize)
End If
SerialLet = res
End Function

Public Function SerialAdd(ByVal SValue As String, Optional ByVal Bits As String = "0123456789", Optional ByRef Overflow As String) As String
SerialAdd = SerialLet(SerialGet(SValue, Bits) + 1, Len(SValue), Bits, Overflow)
End Function

Private Function TestString(ByVal Text As String, ByVal Chars As String) As Boolean
Dim I As Long
For I = 1 To Len(Text)
  If InStr(Chars, Mid$(Text, I, 1)) = 0 Then Exit Function
Next I
TestString = True
End Function

Public Function NextSerialChain(ByVal Chain As String) As String
Const CharDigits As String = "0123456789"
Const CharRLetter As String = "АБВГДЕЖЗИКЛМНОПРСТУФХЦЧШЩЭЮЯ"
Const CharELetter As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
Dim Chains() As String, S As String, C As Long, B As String, PortValue As Long, V As Long
Chains() = Split(Chain, "-")
PortValue = 1
For C = UBound(Chains) To LBound(Chains) Step -1
  S = Chains(C)
  If TestString(S, CharDigits) Then
    B = CharDigits
  ElseIf TestString(S, CharRLetter) Then
    B = CharRLetter
  ElseIf TestString(S, CharELetter) Then
    B = CharELetter
  Else
    B = vbNullString
  End If
  If Len(B) > 0 Then
    V = SerialGet(S, B) + PortValue
    Chains(C) = SerialLet(V, Len(S), B, S)
    PortValue = SerialGet(S, B)
    If PortValue = 0 Then Exit For
  End If
Next C
NextSerialChain = Join(Chains(), "-")
End Function


vbskb_num vbskb_serial

[alibek]

Основная функция - NextSerialChain;
используется так: MsgBox NextSerialChain("01-0012-473")

Остальные функции (SerialGet, SerialLet, SerialAdd) тоже могут пригодиться; NextSerialChain является надстройкой к ним.

[Avtopic]

Спасибо! Ваш код сейчас посмотрю.
Я получил вот такую функцию “счетчика строки”:
Возвращает “следующий стринг”, стараясь не нарушать формат переданного значения, даже если формат сложный.
Буду, признателен, если найдете время протестировать.

Код: Выделить всё

Private Function Get_Next(Str As String) As String
Dim Txt() As Variant, Simb As Variant
Dim i As Integer, j As Integer, k As Integer, Leng As Integer

Const MaxLen = 12    'Limin lenght
Simb = "-/\"    'List of separators
Leng = Len(Str)
ReDim Txt(Leng) As Variant
For i = 1 To Leng
    Txt(i) = Mid(Str, i, 1)
Next
loopBgn: For i = Leng To 1 Step -1
    If IsNumeric(Txt(i)) Then
        Txt(i) = Txt(i) + 1
        Str = ""
        For j = 1 To UBound(Txt)
            Str = Str & Txt(j)    '----Restor
        Next
        If Len(Str) <= Leng Then Get_Next = Str: Exit Function
        Txt(i) = 0
    Else
        If (Asc(Txt(i)) > 64 And Asc(Txt(i)) < 90) Or (Asc(Txt(i)) > 96 And Asc(Txt(i)) < 122) Then
            Txt(i) = Chr(Asc(Txt(i)) + 1)
        Else
            If InStr(1, Simb, Txt(i), 0) > 0 Then GoTo loopNxt:
            If Asc(Txt(i)) < 91 Then Txt(i) = Chr(65) Else Txt(i) = Chr(97)
            GoTo loopNxt:
        End If
        Str = ""
        For j = 1 To UBound(Txt)
            Str = Str & Txt(j)    '----Restor
        Next
        If Len(Str) <= Leng Then Get_Next = Str: Exit Function
    End If
loopNxt:     Next

If Leng < 12 Then
    Leng = Leng + 1
    ReDim Preserve Txt(UBound(Txt) + 1) As Variant
    If IsNumeric(Txt(UBound(Txt) - 1)) Or IsEmpty(Txt(UBound(Txt) - 1)) Then
        Txt(UBound(Txt)) = 0
    Else
        If Asc(Txt(UBound(Txt) - 1)) < 91 Then Txt(UBound(Txt)) = Chr(65) Else Txt(UBound(Txt)) = Chr(97)
    End If
    GoTo loopBgn:
End If
End Function

[Avtopic]

И сразу же посмотрев ваш код, добавил для русского алфавита.
смешивать можно.

Код: Выделить всё

Private Function Get_Next(Str As String) As String
Dim Txt() As Variant, Simb As Variant
Dim i As Integer, j As Integer, k As Integer, Leng As Integer

Const MaxLen = 12    'Limin lenght
Simb = "-/\"    'List of separators
Leng = Len(Str)
ReDim Txt(Leng) As Variant
For i = 1 To Leng
    Txt(i) = Mid(Str, i, 1)
Next
loopBgn: For i = Leng To 1 Step -1
    If IsNumeric(Txt(i)) Then
        Txt(i) = Txt(i) + 1
        Str = ""
        For j = 1 To UBound(Txt)
            Str = Str & Txt(j)    '----Restor
        Next
        If Len(Str) <= Leng Then Get_Next = Str: Exit Function
        Txt(i) = 0
    Else
        If (Asc(Txt(i)) > 64 And Asc(Txt(i)) < 90) Or (Asc(Txt(i)) > 96 And Asc(Txt(i)) < 122) Or (Asc(Txt(i)) > 191 And Asc(Txt(i)) < 255) Then
            Txt(i) = Chr(Asc(Txt(i)) + 1)
        Else
            If InStr(1, Simb, Txt(i), 0) > 0 Then GoTo loopNxt:
            If Asc(Txt(i)) < 91 Then
                Txt(i) = Chr(65)
            ElseIf Asc(Txt(i)) < 128 Then
                Txt(i) = Chr(97)
            ElseIf Asc(Txt(i)) < 191 Then
                Txt(i) = Chr(192)
            Else
                Txt(i) = Chr(224)
            End If
            GoTo loopNxt:
        End If
        Str = ""
        For j = 1 To UBound(Txt)
            Str = Str & Txt(j)    '----Restor
        Next
        If Len(Str) <= Leng Then Get_Next = Str: Exit Function
    End If
loopNxt:     Next

If Leng < 12 Then
    Leng = Leng + 1
    ReDim Preserve Txt(UBound(Txt) + 1) As Variant
    If IsNumeric(Txt(UBound(Txt) - 1)) Or IsEmpty(Txt(UBound(Txt) - 1)) Then
        Txt(UBound(Txt)) = 0
    Else
        If Asc(Txt(UBound(Txt) - 1)) < 91 Then Txt(UBound(Txt)) = Chr(65) Else Txt(UBound(Txt)) = Chr(97)
    End If
    GoTo loopBgn:
End If
End Function

[alibek]

Не нравится мне эта Get_Next.
Слишком уж она багопотенциальная.

Если нужно смешение разных типов нумераторов в одном поле (т.е. ДОК999 в следующей итерации станет ДОЛ001), то подправь NextSerialChain -- это всего лишь вспомогательная процедура, разбивающая строку на фрагменты и инкрементирующую фрагменты по отдельности. На основе SerialGet/SerialLet можно построить любой нумератор; даже если он по разрядности не будет проходить (численное значение ограничено Long, т.е. около 2 млрд.), то можно разбить строку на несколько и инкреминтировать с переносом разрядов, как это сделано у меня (переменная PortValue).

[Avtopic]

Я уже разобрался с вашим кодом и пристраиваю к моей задаче. Большое спасибо!