Невозможно создать алгоритм для последовательности в VBA

Question

После нескольких часов работы я сдаюсь, поскольку больше не вижу решения.

поэтому я прошу вашей помощи, чтобы создать следующую последовательность:

для примера, приведенного является началом кода: 6D082A

1-й позиции («А») от массива с 16 элементов в этой последовательности : «0», «0», «4», «5», «», «C», «D», «E», «F»)

3-е и 5-е положение (082) имеет значения от 000 до 999 , вторая позиция («D») имеет значения от «A» "до" Z " 1-я позиция (6) имеет значения от 1 до

Таким образом, последовательность из примера выше код: 6D082A 6D082B 6D082C .. 6D082F 6D0830 6D0831 .... 6D083F 6D0840 ... 6D999F 6E0000 ... . 6Z999F 7A0000 .... 9Z999F который является Absolut последний код в этой последовательности

У всех петель внутри счетчиков я потерян!

В конце пользователь должен также ввести данный первый код и количество кодов, которые он хочет. Мой последний судебный процесс (без запуска кода и любого переменного количества кодов для создания.

Sub Create_Barcodes_neu2() 
Dim strErsterBC As String 
Dim intRow As Integer 
Dim str6Stelle As Variant 
Dim intStart6 As Integer 
Dim str6 As String 
Dim i As Integer, ii As Integer, Index As Integer 

'On Error Resume Next 
Dim v As Variant 
str6Stelle = Array("0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "A", "B", "C", "D", "E", "F") '16 Elemente 

strErsterBC = InputBox("Enter the first Barcode.", "Barcode-Generator") 
intRow = InputBox("Enter the number of barcodes to create.", "Barcode-Generator") 
intStart6 = ListIndex(Mid(strErsterBC, 6, 1), str6Stelle) 
str35stelle = CInt(Mid(strErsterBC, 3, 3)) 'Zahl 000-999 

str2stelle = Mid(strErsterBC, 2, 1) letters A-Z 
str1stelle = Left(strErsterBC, 1) 

'Debug.Print str6Stelle(1); vbTab; str6Stelle(2); vbTab; str6Stelle(15); vbTab; str6Stelle(16) 
For Z = 0 To 32 
    ausgabe6 = i + intStart6 
    i = i + 1 
    ausgabe35 = str35stelle 
    ausgabe2 = i3 
    ausgabe1 = i4 
    If i = 16 Then 
     i = 0 
     i2 = i2 + 1 
     ausgabe35 = i2 + str35stelle 
     If i2 = 999 Then 
      ausgabe35 = 999 
      i2 = 0 
      i3 = i3 + 1 

      If i3 = 26 Then 
       ausgabe2 = 26 
       i3 = 1 
       i4 = i4 + 1 

       If i4 > 9 Then 
       MsgBox "Ende" 
       Exit Sub 
       End If 

      End If 

     End If 

    End If 

st6 = str6Stelle(ausgabe6) 
st35 = Format(ausgabe35, "000") 
ausgabe2 = Chr(i3) 
ausgabe1 = i4 
    Next Z 

End Sub 

Надеется, что вы можете помочь мне в моем решении! Большого спасибо! Майкл

Answer 1

Я не уверен, если это то, что вы ищете:

Option Explicit 

Const MAX_FIRST_DEC_NUMBER As Integer = 9 
Const MAX_MIDDLE_DEC_NUMBER As Integer = 999 
Const MAX_LAST_HEX_NUMBER As Long= &HF 

Sub Makro() 

    Dim codes() As String 
    Dim startCode As String 
    Dim numOfBarcodes As Integer 

    startCode = "0A0000" ' Starting with the "lowest" barcode 

    ' Maximum number of barcodes = 4,160,000 because: 
         '0-9' *  'A-Z' *  '0-9' *  '0-9' *  '0-9' *  'A-F' 
    numOfBarcodes = CLng(10) * CLng(26) * CLng(10) * CLng(10) * CLng(10) * CLng(16) 

    codes = CreateBarcodes(startCode , numOfBarcodes) 

    Dim i As Integer 
    For i = 0 To numOfBarcodes - 1 
     Debug.Print codes(i) 
    Next 

End Sub 


' NOTE: Given "9Z999F" as start code will give you a numberOfBarcodes-sized array with 
' one valid barcode. The rest of the array will be empty. There is room for improvement. 
Function CreateBarcodes(ByVal start As String, ByVal numberOfBarcodes As Long) As String() 

    ' TODO: Check if "start" is a valid barcode 
    ' ... 

    ' Collect barcodes: 

    Dim firstDecNumber As Integer 
    Dim char As Integer 
    Dim middleDecNumber As Integer 
    Dim lastLetter As Integer 

    ReDim barcodes(0 To numberOfBarcodes - 1) As String 

    For firstDecNumber = Left(start, 1) To MAX_FIRST_DEC_NUMBER Step 1 

     For char = Asc(Mid(start, 2, 1)) To Asc("Z") Step 1 

      For middleDecNumber = CInt(Mid(start, 3, 3)) To MAX_MIDDLE_DEC_NUMBER Step 1 

       For lastLetter = CInt("&H" + Mid(start, 6, 1)) To MAX_LAST_HEX_NUMBER Step 1 

        numberOfBarcodes = numberOfBarcodes - 1 

        barcodes(numberOfBarcodes) = CStr(firstDecNumber) + Chr(char) + Format(middleDecNumber, "000") + Hex(lastLetter) 

        If numberOfBarcodes = 0 Then 
         CreateBarcodes = barcodes 
         Exit Function 
        End If 

       Next 

      Next 

     Next 

    Next 

    CreateBarcodes = barcodes 

End Function 

Выход:

9Z999F 
9Z999E 
9Z999D 
... 
1A0001 
1A0000 
0Z999F 
0Z999E 
... 
0B0002 
0B0001 
0B0000 
0A999F 
0A999E 
... 
0A0011 
0A0010 
0A000F 
0A000E 
... 
0A0003 
0A0002 
0A0001 
0A0000 

Answer 2

Подход к правильному алгоритму состоит в том, чтобы считать число следующим образом:
Давайте возьмем нормальное десятичное трехзначное число. Каждая цифра может принимать один элемент упорядоченного набора символов, 0-9.
Чтобы добавить 1 к этому номеру, мы заменим самый правый символ для следующего символа (2 становится 3 и т. Д.), Но если он уже является «самым высоким» возможным символом («9»), , то установите его в первый возможный символ («0») и увеличить следующую цифру слева на единицу. Таким образом, 129 становится 130, а 199 имеет два переполнения и становится 200. Если бы у нас было 999, а try и inc - один, у нас было бы окончательное переполнение. Теперь это легко сделать с помощью любого набора символов, и они могут быть совершенно разными для каждой цифры.

В коде хранятся наборы символов для каждой цифры. И сама «номер» хранится как массив индексов, указывая на какой символ используется в каждой позиции. Эти индексы легко могут быть увеличены. В случае переполнения для одной цифры функция IncByOne вызывается рекурсивно для следующей позиции слева.

Это код класса clSymbolNumber

Option Explicit 

' must be a collection of arrays of strings 
Public CharacterSets As Collection 
' <code> must contain integers, the same number of elements as CharacterSets 
' this is the indices for each digit in the corresponding character-set 
Public code As Variant 

Public overflowFlag As Boolean 

Public Function IncByOne(Optional position As Integer = -1) As Boolean 
    IncByOne = True 
    If position = -1 Then position = CharacterSets.Count - 1 
    ' overflow at that position? 
    If code(position) = UBound(CharacterSets(position + 1)) Then 
     If position = 0 Then 
      overflowFlag = True 
      IncByOne = False 
      Exit Function 
     Else 
      ' reset this digit to lowest symbol 
      code(position) = 0 
      ' inc the position left to this 
      IncByOne = IncByOne(position - 1) 
      Exit Function 
     End If 
    Else 
     code(position) = code(position) + 1 
    End If 
End Function 

Public Sub class_initialize() 
    overflowFlag = False 
    Set CharacterSets = New Collection 
End Sub 

Public Function getCodeString() As String 
    Dim i As Integer 
    Dim s As String 
    s = "" 
    For i = 0 To UBound(code) 
     s = s & CharacterSets(i + 1)(code(i)) 
    Next 
    getCodeString = s 
End Function 

Тестирование суб в модуле рабочего листа - это выводит все возможные «номера» с заданными тестовыми данными.

Sub test() 
    Dim n As New clSymbolNumber 
    n.CharacterSets.Add Array("1", "2", "3") 
    n.CharacterSets.Add Array("a", "b") 
    n.CharacterSets.Add Array("A", "B", "C", "D") 
    n.CharacterSets.Add Array("1", "2", "3") 
    ' start code (indexes) 
    n.code = Array(0, 0, 0, 0) 
    ' output all numbers until overflow 
    Dim row As Long 
    row = 2 
    Me.Columns("A").ClearContents 
    While Not n.overflowFlag 
     Me.Cells(row, "A") = n.getCodeString 
     n.IncByOne ' return value not immediately needed here 
     row = row + 1 
     DoEvents 
    Wend 
    MsgBox "done" 
End Sub