【算法】请问怎么生成5位永不重复的数字啊

Question

我要每次运行时都能生成和前面不重复的唯一数字，我每次生成1000个

Answer 1

declare @n intselect @n=fieldname from tablename order by newid()delete tableanme where fieldname=@nselect @n

Answer 2

to creazyfish(梳分头的鱼):
产品编号不是明码吗？不明白被人猜到下一个序列号有什么不妥？

Answer 3

creazyfish(梳分头的鱼) ：对呀

Answer 4

先帖上一个 算法有待改进 因为数据快用完的时候可能会 进入4循环Private Function GetNum() As Long
    Dim lngKey As Long
    Dim strTimer As String
    Static oClcNum As Collection
    On Error Resume Next
    Err.Clear
    strTimer = Timer
    Do
        DoEvents
        Randomize strTimer
        lngKey = Int((99999 * Rnd) + 10000)   'lngKey 保证其唯一性
        oClcNum.Add lngKey, Key:=CStr(lngKey) '如果重复会出错
    Loop Until Err.Number = 0
    On Error GoTo 0 '取消错误陷阱
    GetNum = lngKey
End Function

Answer 5

viena(维也纳nn)(实心木头人) 他的意思就是相当于得到一个注册号一样呵呵差不多就是这个意思吧呵呵

Answer 6

我改进了一下 Option Explicit
Private m_oClcNum As Collection'取得号码
Private Function GetNum() As Long
    Dim lngKey As Long, lngEnd As Long
    lngEnd = m_oClcNum.Count '他的个数,说明还有lngEnd个没有分配完
    Randomize Timer
    lngKey = Int((lngEnd * Rnd) + 1)   'lngKey为获取m_oClcNum里的第几个元素
    m_oClcNum.Remove (lngKey) '注意lngKey是数字不是字符串,
    GetNum = lngKey
End FunctionPrivate Function InitCollection()
    Dim i As Long
    For i = 10000 To 99999
        DoEvents
        m_oClcNum.Add i, CStr(i)
    Next
    '这里读取数据库把已经分配的号码 从m_oClcNum剔除掉 譬如：
    '12000 这个号已经分配 添加这个代码：
    'm_oClcNum.Remove ("12000") '记住是字符串"12000"而不是数字
End FunctionPrivate Sub Command1_Click()
Dim lngTest As Long
lngTest = GetNum()
'保存 lngTest 到数据库说明已经分配了 这个号码
End Sub

Answer 7

忘记贴了这个 过程：Private Sub Form_Load()
    Call InitCollection
End Sub

Answer 8

不好意思 我调试了一下 有点错误 下面是 调试后的代码：Option Explicit
Private m_oClcNum As New Collection'取得号码
Private Function GetNum() As Long
    Dim lngKey As Long, lngEnd As Long, lngRet As Long
    lngEnd = m_oClcNum.Count '他的个数,说明还有lngEnd个没有分配完
    Randomize Timer
    lngKey = Int((lngEnd * Rnd) + 1)   'lngKey为获取m_oClcNum里的第几个元素
    lngRet = m_oClcNum.Item(lngKey)
    m_oClcNum.Remove (lngKey) '注意lngKey是数字不是字符串,
    GetNum = lngRet
End FunctionPrivate Function InitCollection()
    Dim i As Long
    For i = 10000 To 99999
        DoEvents
        m_oClcNum.Add i, CStr(i)
    Next
    '这里读取数据库把已经分配的号码 从m_oClcNum剔除掉 譬如：
    '12000 这个号已经分配 添加这个代码：
    'm_oClcNum.Remove ("12000") '记住是字符串"12000"而不是数字
End FunctionPrivate Sub Command1_Click()
    Dim lngTest As Long
    lngTest = GetNum()
    MsgBox lngTest
    '保存 lngTest 到数据库说明已经分配了 这个号码
End SubPrivate Sub Form_Load()
    Call InitCollection
End Sub

Answer 9

思路:
   1.定义一个数组(S),下标从 10000-99999 ,把10000-99999顺序放到数组里
   2.用一个从10000-99999的循环(i=10000 to 99999),每循环一次生成一个10000-99999(tmpXB)之间的数字,然后把以i为下标的数字跟以tmpXB为下标的数字交换,也就是打乱数组里的值的顺序
   3.由于10000-99999数组较大,只进行一次交换可能结果不能令人满意,所以我在程序里交换了10(j)次,效果基本还可以,如果您觉的不够乱,可以调大一些,我的机器(赛扬1.7G)进行10次交换用1.65秒,您可以根据实际情况调整
   4.经过以上运算,数组S里的值已经被打乱,用循环顺序取下标就可以了,用多少取多少...哈哈~~~~~
代码如下,窗体放一个按钮即可,程序会把结果输出到1.txt里
Option Explicit
Dim S(10000 To 99999) As Long '定义数组Private Sub Command1_Click()Dim i, j As Long  '循环用
Dim tmpChg As Long  '交换时用到的变量
Dim tmpXB As Long    '生成的随机下标
Dim Stime, Etime   '记录运行时间Stime = TimerFor i = 10000 To 99999   '给数组赋值
    S(i) = i
NextFor j = 1 To 10   '由于10000-99999 数字比较大,交换一遍可能顺序不够乱,这里交换10遍^_^    For i = 10000 To 99999   '随机产生的下标和当前下标值进行交换
        Randomize
        tmpXB = CLng((99999 - 10000 + 1) * Rnd + 10000)
        tmpChg = S(i)
        S(i) = S(tmpXB)
        S(tmpXB) = tmpChg
    NextNextOpen App.Path & "\1.txt" For Output As #1   '输出到文件For i = 10000 To 99999
    Print #1, S(i)
NextEtime = Timer - StimePrint #1, "用时:" & Etime   '我的机器交换10次用1.65秒时间,我的赛扬1.7G CPUClose #1End Sub

Answer 10

baoaya(点头) 兄的办法到是可以实现...刚刚我测试了一下,速度确实成问题...越往后越慢呀.....测试代码(其他代码没有变...):
Private Sub Command1_Click()Dim i, j As Long  '循环用
Dim Stime, Etime   '记录运行时间Stime = TimerOpen App.Path & "\1.txt" For Output As #1   '输出到文件For i = 10000 To 99999
    Print #1, "第"; i - 10000; "个:" & GetNum()
    Print #1, "用时:" & Timer - Stime
NextEtime = Timer - StimeClose #1
MsgBox "ok"
End Sub
测试结果...
第 0 个:50632
用时:0
第 1 个:43174
用时:.015625
第 2 个:23351
用时:.015625
第 3 个:58921
用时:.015625
第 4 个:42213
用时:.015625
第 5 个:26235
用时:.015625
第 6 个:50269
用时:.03125
第 7 个:44268
用时:.03125
第 8 个:14466
用时:.03125
第 9 个:13868
用时:.03125
第 10 个:81760
用时:.046875.........第 1500 个:52861
用时:9.5
第 1501 个:39170
用时:9.5
第 1502 个:32433
用时:9.5
第 1503 个:52627
用时:9.515625
第 1504 个:82087
用时:9.515625
第 1505 个:83775
用时:9.53125..........第 6270 个:91902
用时:38.625
第 6271 个:79103
用时:38.64063
第 6272 个:51557
用时:38.65625
第 6273 个:86282
用时:38.65625
第 6274 个:90346
用时:38.67188
第 6275 个:35958
用时:38.67188
第 6276 个:85323
用时:38.6875.......第 7825 个:42320
用时:47.40625
第 7826 个:83966
用时:47.40625
第 7827 个:24971
用时:47.42188
第 7828 个:69788
用时:47.42188
第 7829 个:25333
用时:47.42188
第 7830 个:44835
用时:47.42188
第 7831 个:34237
用时:47.4375再往后就没测了,我的VB 没有响应了 -_-!!

Answer 11

改进了刚才的GetNum函数，添加了分配完5位数的错误处理'取得号码
Private Function GetNum() As Long
    Dim lngKey As Long, lngEnd As Long, lngRet As Long
    lngEnd = m_oClcNum.Count '他的个数,说明还有lngEnd个没有分配完
    If lngEnd > 0 Then
        Randomize Timer
        lngKey = Int((lngEnd * Rnd) + 1)   'lngKey为获取m_oClcNum里的第几个元素
        lngRet = m_oClcNum.Item(lngKey)
        m_oClcNum.Remove (lngKey) '注意lngKey是数字不是字符串,
        GetNum = lngRet
    Else '分配光了返回负数
        GetNum = -1
    End If
End FunctionPrivate Sub Command1_Click()
    Dim lngTest As Long
    lngTest = GetNum()
    If lngTest > 0 Then
        MsgBox lngTest
        '保存 lngTest 到数据库说明已经分配了 这个号码
        '......
    Else
        MsgBox "对不起,5位数已经分配完了!"
    End If
End Sub

Answer 12

用链表的方法做的
Dim curpos As Long
Dim serarr(10000 To 99999) As Long
Private Sub Command1_Click()
    Dim i As Long
    Dim j As Long
    Dim step As Long
    Dim nextpos As Long
    Open "d:\1.txt" For Output As #1
    For i = 1 To 1000
    If serarr(curpos) = curpos Then
        Print #1, "第" & i & "次：" & serarr(curpos)
        Exit For
    End If
    Randomize
    step = 100000 * Rnd
        For j = 1 To step - 1
            nextpos = serarr(curpos)
            curpos = nextpos
        Next
        
        Print #1, "第" & i & "次：" & serarr(curpos)
        serarr(curpos) = serarr(serarr(curpos))
    Next i
    Close #1
End SubPrivate Sub Command2_Click()
    Form_Load
End SubPrivate Sub Form_Load()
    Dim i As Long
    For i = 10000 To 99999
       serarr(i) = i + 1
    Next
    serarr(99999) = 10000
    curpos = 10000
End Sub

Answer 13

Private Sub Command1_Click()
getnnum 1000
End Sub
Sub getnnum(ByVal n As Long, Optional ByRef result As String)
If n > 90000 Then MsgBox n & " is too larger": Exit Sub
Dim x(10000 To 99999) As Long, y() As String, i As Long, j As Long, temp As Long
ReDim y(1 To n)
For i = 10000 To 99999
x(i) = i
Next
For j = 1 To n
temp = Int((90000 - j) * Rnd + 10000)
y(j) = "No" & j & vbTab & x(temp)
x(temp) = 99999 - j
Next
result = Join(y, vbCrLf)
Erase x
Debug.Print result
Erase y
End Sub

Answer 14

我也认为用五位数字效果不好，性能肯定会很慢的，因为越到后来想得到一个与前面不重复的数字越困难。还是将序号长度加大，用其它方法的到一个不重复的随机数好了。比如：guid。