随机生成4位数 不重复

[iroad1985]

随机生成6101个四位数

这些数字要不同

然后就是以 “0000” “0143”“4597”之类的形式出现 结果输出到窗体

[of123]

Private Declare Function SendMessagebyString Lib _
"user32" Alias "SendMessageA" (ByVal hWND As Long, _
ByVal wMsg As Long, ByVal wParam As Long, _
ByVal lParam As String) As Long

Private Const LB_FINDSTRINGEXACT = &H1A2 '在 ListBox 中精确查找

Private Sub Command1_Click()
Dim i As Long, n As Long, tmp As String

List1.Clear
Randomize

Do Until List1.ListCount = 6101
tmp = Right("000" & CStr(Int(Rnd() * 10000)), 4)
n = SendMessagebyString(List1.hWND, LB_FINDSTRINGEXACT, -1, tmp)
If n = -1 Then
List1.AddItem tmp
List1.ListIndex = List1.ListCount - 1
List1.ListIndex = -1
List1.Refresh
End If
Loop
End Sub

[of123]

另一种方法：字典方式

Dim i As Integer, n As Integer


Private Sub Command1_Click()
List1.Clear

Randomize
For i = 1 To 6101
n = Int(Rnd() * List2.ListCount)
List1.AddItem List2.List(n)
List2.RemoveItem n

' List1.ListIndex = List1.NewIndex
' List1.ListIndex = -1
' List1.Refresh
Next i
End Sub

Private Sub Form_Load()
List2.Visible = False
For i = 0 To 9999
List2.AddItem Right("000" & CStr(i), 4)
Next i
End Sub

[of123]

如果要多次执行：

Private Sub Command1_Click()
List1.Clear

Randomize
For i = 1 To 6101
n = Int(Rnd() * List2.ListCount)
List1.AddItem List2.List(n)
List2.RemoveItem n

' List1.ListIndex = List1.NewIndex
' List1.ListIndex = -1
' List1.Refresh
Next i

List2.Clear
Form_Load
End Sub

[patrick_kong]

第一种方法好像不行，主要是Int(Rnd() * 10000)), 不能保证不同。
下面的两个list 的想法很好。

[Tiger_Zhao]

用线性同余法
参考 http://topic.csdn.net/u/20070925/11/ae3a11dc-be35-4425-b424-8e316d71e0e0.html

[赵4老师]

将0000～9999这10000个数用洗牌算法打乱，然后按顺序给出前6101个即可

dim d(0 to 9999) as integer
dim i as integer
dim a as integer
dim b as integer
dim t as integer
Randomize
for i=0 to 9999
    d(i)=i
next
for i=10000 to 1 step -1
    a=i-1:b=int(rnd()*i)
    if a<>b then
        t=d[a]:d[a]=d[b]:d[b]=t
    end if
next
for i=0 to 6100
    debug.print format(d[i],"0000");" ";
    if i mod 50=49 then debug.print
next

[chinaboyzyq]

Option Explicit

Private Sub Command1_Click()
   Randomize Timer
   Dim j As Integer, i As Integer
   Dim temp As String, num() As String
   
   List1.Clear
   ReDim num(9999)
   For i = 0 To 9999
       num(i) = Format(i, "0000")
   Next
   For i = 0 To 9999 '打乱
       j = Int(Rnd * 10000)
       temp = num(j)
       num(j) = num(i)
       num(i) = temp
   Next
   ReDim Preserve num(6100) '取结果
   
   For i = 0 To 6100
      List1.AddItem num(i) '输出，设计时设置Sorted为true可自动排序。
  Next
  
   MsgBox "ok"
End Sub

[skylinecn]

窗体一个Text1,Command1。
Text1.MultiLine = True: Text1.ScrollBars = 2

Private Sub Command1_Click()
Dim s$, ss$
For i = 1 To 6101
    DoEvents: s = Format(Rnd * 10000, "0000")
    If 0 = InStr(ss, s) Then ss = ss & s & vbCrLf Else i = i - 1
Next i
Form1.Text1.Text = ss
End Sub

[cbm6666]

引用楼主 iroad1985 的回复:

随机生成6101个四位数

随机生成6101个四位数, 何谓四位数? 这可不是在挑语病, 四位数是1000-9999, 然而999用Format把它变成四个字符, 而称为四位数, 似乎太牵强了....

楼上所有的都是从0-10000 我就写个 "另类" 1000-9999 的 四位数 不重复 的随机数吧
'**********************************************************************

Option Explicit
Dim Arr&(), RndVal&, TmpVal&, i&, S
Private Sub Form_Click()
Call GetRnd(1000, 9999, 6101)
End Sub

Sub GetRnd(MinVal&, MaxVal&, Optional Qty&)
If MinVal > MaxVal Or (MaxVal - MinVal + 1) < Qty Then Exit Sub
Randomize
For i = MinVal To MaxVal
ReDim Preserve Arr&(i)
Arr(i) = i
Next i
For i = MinVal To MaxVal
RndVal = Int(Rnd * (MaxVal - MinVal + 1)) + MinVal
TmpVal = Arr(i)
Arr(i) = Arr(RndVal)
Arr(RndVal) = TmpVal
Next i
Me.Cls
For i = 0 To Qty - 1
Arr(i) = Arr(i + MinVal)
Print Arr(i)
Next i
End Sub

[moke520]

引用 9 楼 cbm666 的回复:

引用楼主 iroad1985 的回复:随机生成6101个四位数

随机生成6101个四位数, 何谓四位数? 这可不是在挑语病, 四位数是1000-9999, 然而999用Format把它变成四个字符, 而称为四位数, 似乎太牵强了....

楼上所有的都是从0-10000 我就写个 "另类" 1000-9999 的 四位数 不重复 的随机数吧
'**********************************************************************

Option Explicit
Dim Arr&(), RndVal&, TmpVal&, i&, S
Private Sub Form_Click()
  Call GetRnd(1000, 9999, 6101)
End Sub

Sub GetRnd(MinVal&, MaxVal&, Optional Qty&)
  If MinVal > MaxVal Or (MaxVal - MinVal + 1) < Qty Then Exit Sub
  Randomize
  For i = MinVal To MaxVal
      ReDim Preserve Arr&(i)
      Arr(i) = i
  Next i
  For i = MinVal To MaxVal
      RndVal = Int(Rnd * (MaxVal - MinVal + 1)) + MinVal
      TmpVal = Arr(i)
      Arr(i) = Arr(RndVal)
      Arr(RndVal) = TmpVal
  Next i
  Me.Cls
  For i = 0 To Qty - 1
      Arr(i) = Arr(i + MinVal)
      Print Arr(i)
  Next i
End Sub

又看了下楼主的题目.. 貌似 "0000" 也算 -.-

[moke520]

cbm666 老师的我F8跑过都没看明白是怎么保证不重复的 - -

[思考]

第一种方法可以的
n = SendMessagebyString(List1.hWND, LB_FINDSTRINGEXACT, -1, tmp)
If n = -1 Then
这就是判断有没有重复的

[liguicd]

引用 6 楼 zhao4zhong1 的回复:

将0000～9999这10000个数用洗牌算法打乱，然后按顺序给出前6101个即可

这个方案不错！

[BUYUELEICHI]

第一种方法用Randomize初始化随机数生成器。