经过几个小时的工作后，我放弃了，因为我再也看不到解决方案了。
因此，我请求您帮助创建以下序列：
例如，给出的是起始码：6D082A
第一个位置（“A”）来自一个包含16个元素的数组： 数组（“0”，“1”，“2”，“3”，“4”，“5”，“6”，“7”，“8”，“9”，“A”，“B”， “C”，“D”，“E”，“F”）
第3至第5位置（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
希望你能在我的解决方案中帮助我！ 非常感谢！ 迈克尔
答案 0 :(得分：0)
我不确定这是否是您正在寻找的：
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
答案 1 :(得分：0)
正确算法的方法是以下列方式考虑数字：
我们取一个正常的十进制3位数字。每个数字可以取一组有序符号的一个元素，0-9
要为此数字加1，我们将最右边的符号换成下一个符号（2变为3等） - 但如果它已经是'最高'可能的符号（“9”），
然后将其重置为第一个可能的符号（“0”），并将下一个数字向左增加一个。
因此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 - 这将使用给定的测试数据输出所有可能的“数字”。
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