vb6 随机数无重复且无零

Question

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

我有三个要求，没有重复值，没有零，长度为 9 个字符
我已经接近这两种非常不同的方式，随机数生成器方法使 FindAndReplace 工作失败但代码太多

问题是
如何修改 GetNumber 方法代码以满足三个要求？
或者
如何简化 FindAndReplace 代码以每次反映一个全新的数字序列？

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

我没有 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 2

这是一种生成不带零的 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 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

vb6 随机数无重复且无零

vb6 random number no duplicates & no zeros

random

vb6