VB6随机数没有重复和零

Question

我正在使用 vb6 并尝试生成一个随机数或字符串，这种格式
S1 = "378125649">

我有三个要求 没有重复的值 &没有零 和长度的
9 个字符我已经接近了这两种非常不同的随机数生成器方法无法正常工作但代码
太多

问题是如何
修复 GetNumber 方法代码以满足三个要求？
或者
如何简化查找和替换代码以每次反映全新的数字序列？

获取编号代码如下

Private Sub GetNumber()
Randomize
Dim MyRandomNumber As Long 'The chosen number
Dim RandomMax As Long 'top end of range to pick from
Dim RandomMin As Long 'low end of range to pick from
'Dim Kount As Long 'loop to pick ten random numbers
RandomMin = 1
RandomMax = 999999999
MyRandomNumber = Int(Rnd(1) * RandomMax) + RandomMin
lbOne.AddItem CStr(MyRandomNumber) & vbNewLine
End Sub

下面的
查找和替换代码

Private Sub FindAndReplace()
Dim S4 As String
S4 = "183657429"
Dim T1 As String
Dim T2 As String
Dim J As Integer
Dim H As Integer

J = InStr(1, S4, 2)
H = InStr(1, S4, 8)
T1 = Replace(S4, CStr(J), "X")
T1 = Replace(T1, CStr(H), "F")

If Mid(T1, 8, 1) = "F" And Mid(T1, 2, 1) = "X" Then
T2 = Replace(T1, "F", "8")
T2 = Replace(T2, "X", "2")
End If
tbOne.Text = CStr(J) & " " & CStr(H)
lbOne.AddItem "Original Value " & S4 & vbNewLine
lbOne.AddItem "New Value      " & T2 & vbNewLine
End Sub

Answer 1

这是一种生成没有零的 9 位随机数的方法。 基本思想是按位置构建一个 9 个字符的字符串位置，其中每个位置都是 1 到 9 之间的随机数。 然后将每个字符串添加到集合中以删除任何重复项。 此代码将生成 100,000 个唯一数字：

Option Explicit
Private Sub Command1_Click()
Dim c As Collection
Set c = GetNumbers()

MsgBox c.Count
End Sub
Private Function GetNumbers() As Collection
On Error Resume Next
Dim i As Integer
Dim n As String

Randomize
Set GetNumbers = New Collection

Do While GetNumbers.Count < 100000
n = ""

For i = 1 To 9
n = n & Int((9 * Rnd) + 1)
Next

GetNumbers.Add n, n
Loop
End Function

在我的测试中，此代码仅为返回的 100,000 个唯一数字生成了 2 个重复项。

Answer 2

我没有 VB6 编译器，所以我把它放飞了：

Function GetNumber(lowerLimit as Integer, upperLimit As Integer) As Integer
Dim randomNumber As String
Dim numbers As New Collection

Randomize
For i As Integer = lowerLimit To upperLimit
Call numbers.Add(i)
Next
For j As Integer = upperLimit To lowerLimit Step -1
Dim position As Short = Int(((j - lowerLimit)* Rnd) + 1)
randomNumber = randomNumber & numbers(position)

Call numbers.Remove(position)
Next

Return(CInt(randomNumber))
End Function

例如，通过调用来使用该函数：

GetNumber(1, 9)

Answer 3

我的机器上不再有 VB6，所以这里有一个用 Excel 编写的解决方案，它使用数组对123456789中的数字进行洗牌。

您应该只需很少的转换即可使用它：

Private Function RndNumber() As String
Dim i, j As Integer
Dim tmp As Variant
Dim digits As Variant
digits = Array("1", "2", "3", "4", "5", "6", "7", "8", "9")
For i = 0 To UBound(digits)
j = Int(9 * Rnd)
tmp = digits(i)
digits(i) = digits(j)
digits(j) = tmp
Next
RndNumber = Join(digits, "")
End Function

这里有一个变体，它将洗牌你传入的数组，并用指定的分隔符将它们连接在一起。 请注意，传入的数组是变体类型，因此可以对任何内容进行洗牌。 第一个数组有数字，而第二个数组有字符串：

Private Sub Foo()
Dim digits As Variant
digits = Array(1, 2, 3, 4, 5, 6, 7, 8, 9)

Dim rndNnumber As String
RndNumber = ShuffleArrayAndJoin(digits, "")
Debug.Print RndNumber

Dim pets As Variant
pets = Array("cat", "dog", "fish", "hamster")
Dim rndPets As String
rndPets = ShuffleArrayAndJoin(pets, ", ")
Debug.Print (rndPets)
End Sub
Private Function ShuffleArrayAndJoin(ByVal sourceArray As Variant, ByVal separator As String) As String
Dim i, j As Integer
Dim tmp As Variant
For i = 0 To UBound(sourceArray)
j = Int(UBound(sourceArray) * Rnd)
tmp = sourceArray(i)
sourceArray(i) = sourceArray(j)
sourceArray(j) = tmp
Next
ShuffleArrayAndJoin = Join(sourceArray, separator)
End Function

Answer 4

Function GetNumber() As String
Dim mNum As String
Randomize Timer
Do While Len(mNum) <> 9
mNum = Replace(Str(Round(Rnd(Timer), 6)) + Str(Round(Rnd(Timer), 3)), " .", "")
Loop
GetNumber = mNum
End Function

一直在单击按钮以加载文本框几分钟，但到目前为止没有欺骗，我敢打赌钱永远不会有任何..

Answer 5

好吧，它只解决了 1 个问题：它永远不会重复数字 但它必须是 15+ 数字长...

Function genRndNr(nrPlaces)  'must be more then 10
Dim prefix As String
Dim suffix As String
Dim pon As Integer
prefix = Right("0000000000" + CStr(DateDiff("s", "2020-01-01", Now)), 10)
suffix = Space(nrPlaces - 10)
For pon = 1 To Len(suffix)
Randomize
Randomize Rnd * 1000000
Mid(suffix, pon, 1) = CStr(Int(Rnd * 10))
Next
genRndNr = prefix + suffix
End Function