无法为VBA中的序列创建算法 [英] Cannot create algorithm for a sequence in VBA
问题描述
因此，我请求您的帮助以创建以下顺序：
例如给出的是起始代码：6D082A
第一个位置（A）来自一个16个元素的数组这个序列：
数组（0，1，2，3，4，5，6，7，8，9 A，B，C，D，E，F）
第3到第5位（082）至999
第二名（D）具有从A到Z的值
第一个位置（6）的值为1-9
所以上面的示例代码的顺序是：
6D082A
6D082B
6D082C
..
6D082F
6D0830
6D0831
....
6D083F
6D0840
...
6D999F
6E0000
....
6Z999F
7A0000
....
9Z999F这是这个序列中绝对的最后一个代码
如果柜台内的所有循环都是失去了！
最后，用户开始ld还输入给定的第一个代码和他想要的代码数。
我的最后一次审判是（没有任何开始代码和任何可变数量的代码创建。
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 ，5，6，7，8，9，A，B，C，D，E '16 Elemente
strErsterBC = InputBox（输入第一个条形码，条形码生成器）
intRow = InputBox（输入要创建的条形码数量，条形码-Generator）
intStart6 = ListIndex（Mid（strErsterBC，6，1），str6Stelle）
str35stelle = CInt（Mid（strErsterBC，3，3））'Zahl 000-999
str2stelle = Mid（strErsterBC，2，1）字母AZ
str1stelle = Left（strErsterBC，1）
'Debug.Print str6Stelle（1）; vbTab; str6Stelle（2） ; vbTab; str6Stelle （15）; vbTab; str6Stelle（16）
对于Z = 0到32
ausgabe6 = i + intStart6
i = i + 1
ausgabe35 = str35stelle
ausgabe2 = i3
ausgabe1 = i4
如果i = 16则
i = 0
i2 = i2 + 1
ausgabe35 = i2 + str35stelle
如果i2 = 999则
ausgabe35 = 999
i2 = 0
i3 = i3 + 1
如果i3 = 26然后
ausgabe2 = 26
i3 = 1
i4 = i4 + 1
如果i4> 9然后
MsgBoxEnde
退出子
结束如果
结束如果
结束如果
结束如果
st6 = str6Stelle（ausgabe6）
st35 =格式（ausgabe35，000）
ausgabe2 = Chr（i3）
ausgabe1 = i4
下一个Z
End Sub
希望你能帮我解决！
非常感谢！
Michael
我不知道这是你要找的：
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代码（）As String
Dim startCode As String
Dim numOfBarcodes As Integer
startCode =0A0000'从最低条码开始
'条形码最大数量= 4,160,000因为：
'0-9'*'A- Z'*'0-9'*'0-9'*'0-9'*'A-F'
numOfBarcodes = CLng（10）* CLng（26）* CLng（10）* CLng ）* CLng（10）* CLng（16）
codes = CreateBarcodes（startCode，numOfBarcodes）
Dim i As Integer
For i = 0 To numOfBarcodes - 1
Debug.Print代码（i）
下一个
结束Sub
'注意：给定9Z999F作为起始代码将为您提供一个numberOfBarcodes大小的数组，
'一个有效的条形码。数组的其余部分将为空。还有改进的余地。
函数CreateBarcodes（ByVal start As String，ByVal numberOfBarcodes As Long）As String（）
'TODO：检查start是否为有效的条形码
'...
'收集条形码：
Dim firstDecNumber As Integer
Dim char As Integer
Dim middleDecNumber As Integer
Dim lastLetter As Integer
ReDim条形码（0到numberOfBarcodes - 1）As String
对于firstDecNumber = Left（开始，1）到MAX_FIRST_DEC_NUMBER步骤1
对于char = Asc中间（开始，2，1））到Asc（Z）步骤1
对于middleDecNumber = CInt（中（开始，3，3））到MAX_MIDDLE_DEC_NUMBER步骤1
对于lastLetter = CInt（& H+ Mid（开始，6，1））到MAX_LAST_HEX_NUMBER步骤1
numberOfBarcodes = numberOfBarcodes - 1
条形码（numberOfBarcodes ）= CStr（firstDecNumber）+ Chr（char）+ Format（middleDecNumber，000）+ Hex（lastLette r）
如果numberOfBarcodes = 0然后
CreateBarcodes =条形码
退出函数
结束如果
下一个
下一个
下一个
下一个
CreateBarcodes =条形码
结束函数
输出：
9Z999F
9Z999E
9Z999D
...
1A0001
1A0000
0Z999F
0Z999E
...
0B0002
0B0001
0B0000
0A999F
0A999E
...
0A0011
0A0010
0A000F
0A000E
...
0A0003
0A0002
0A0001
0A0000
After hours of work I give up as I do not see the solution anymore.
I therefore ask for your help to create following sequence:
for example given is the start code: 6D082A
The 1st position ("A") is from an array with 16 elements in this sequence: Array("0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "A", "B", "C", "D", "E", "F")
the 3rd to 5th position (082) has values from 000 to 999 the 2nd position ("D") has values from "A" to "Z" the 1st position (6) has values from 1-9
So the sequence from the example code above is: 6D082A 6D082B 6D082C .. 6D082F 6D0830 6D0831 .... 6D083F 6D0840 ... 6D999F 6E0000 .... 6Z999F 7A0000 .... 9Z999F which is the absolut last code in this sequence
Whith all the loops within the counters I am lost!
At the end the user should also enter the given first code and the number of codes he wants. My last trial was (without any start-code and any variable number of codes to create.
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
Hope you can help me in my solution! Thanks a lot! Michael
I'm not sure if this is what you're looking for:
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
Output:
9Z999F
9Z999E
9Z999D
...
1A0001
1A0000
0Z999F
0Z999E
...
0B0002
0B0001
0B0000
0A999F
0A999E
...
0A0011
0A0010
0A000F
0A000E
...
0A0003
0A0002
0A0001
0A0000
这篇关于无法为VBA中的序列创建算法的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
