无法在VBA中为序列创建算法

工作了几个小时后，我放弃了，因为我再也看不到解决办法了

因此，我请求您帮助创建以下序列：

例如，给出了启动代码：6D082A

第一个位置（“A”）来自此序列中包含16个元素的数组： 数组（“0”、“1”、“2”、“3”、“4”、“5”、“6”、“7”、“8”、“9”、“A”、“B”、“C”、“D”、“E”、“F”）

第三到第五位置（082）的值为000到999 第二个位置（“D”）的值从“A”到“Z” 第一个位置（6）的值为1-9

因此，上述示例代码的顺序是： 6D082A 6D082B 6D082C .. 6D082F 6D0830 6D0831 .... 6D083F 6D0840 ... 6D999F 6E0000 .... 6Z999F 7A0000 .... 9Z999F，这是此序列中的绝对最后一个代码

计数器内的所有循环我都迷路了

最后，用户还应输入给定的第一个代码和所需的代码数。 我的上一次尝试是（没有任何开始代码和任何可变数量的代码来创建）

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

希望你能帮我解决问题！ 谢谢！

---

迈克尔

我不确定这是否是你想要的：

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

---

正确算法的方法是用以下方式思考一个数字：
让我们取一个正常的十进制3位数字。每个数字可以取一个有序的符号集合的一个元素，0－9。 若要将1添加到此数字，我们将最右边的符号替换为下一个符号（2变为3等）-但如果它已经是“最高”的可能符号（“9”）， 然后将其重置为第一个可能的符号（“0”），并将左侧的下一个数字增加1。 所以129变为130，199有两个携带溢出，变成了200。如果我们有999，试着用一个和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

---

因此，如果用户输入“3”，那么如果他将6D082A作为第一个条形码，他将得到6D082A、6D082B、6D082C？谢谢您的回复，但它不起作用。子测试以错误“索引超出数组边界”结束，没有在代码中标记任何行。我无法找到输入起始代码的可能性（例如“6D082A”）以及我想要创建的代码的数量。在我的测试中，代码有效（没有任何更改）。逐步完成测试子部分（F8）逐行，然后你会看到错误所在。请注意，字符集和代码需要相同数量的元素。-但是，是的，你必须编写一个子代码，将开始代码转换为索引，这应该不是很难-只需在相应的字符集中查找每个字符就可以得到每个索引。嗨，Stefan！谢谢你的回答，但我没有得到答案任何条形码作为输出，也没有错误消息。michael@user3480989你试过调试它吗？这应该是开箱即用的。在

CreateBarcodes

调用后设置一个断点，看看

codes

是否包含一些值。嗨，Stefan！很抱歉，我将你的代码与其他代码放在一个模块中，因此它无法运行，可能是由于错误的原因现在，它开始创建条形码，但在最后一个位置，序列应该像我的数组显示的数组（“0”、“1”、“2”、“3”、“4”、“5”、“6”、“7”、“8”、“9”、“A”、“B”、“C”、“D”、“E”、“F”），这意味着在“F”之后，下一个代码以“0”开头，下一个代码有“1”，等等。而且你的代码正在下降。我需要它们上升。从下到上精确输出。谢谢你的帮助！MichaelWhich数组？我的算法只需要一个条形码并从起始位置生成

numobarcode

-条形码。这应该从

0A0000

到

9Z999F

@user3480989。你是serio吗美国？您可以得到一个已排序的条形码数组。只需从

迭代idx=Ubound（代码）到0步骤-1

或更改算法。您只需向

CreateBarcodes

添加一个计数器，该计数器将递增，直到它等于

numberOfBarcodes

，并将其用作结果数组的索引，但这是毫无意义的，因为数组已排序…如果您甚至不能这样做，则应首先解决该问题。维尔温泉酒店。