跪求随机生成1-100的不重复随机函数或者VBA代码？

LIWENHUI2002970

跪求随机生成1-100的不重复随机函数或者VBA代码？我是VBA的新人，现在需要1-100的不重复随机数，急急！

yjh_27

yjh自定义函数 7L
http://club.excelhome.net/thread-1509415-1-1.html
(出处: ExcelHome技术论坛)

duquancai

1. Sub main()
   
2.     Dim D As Object, js As Object
   
3.     Set D = CreateObject("htmlfile"): Set js = D.parentWindow
   
4.     js.execScript "var a=[];for(i=0;i<100;i++)a.push(i+1);a.sort(function(){return 0.5-Math.random()});"
   
5.     MsgBox js.eval("a")
   
6. End Sub

复制代码

FOB_FN_L

Option Explicit
Function RandomNumbers(Lowest As Double, Highest As Double, _
Optional Decimals As Integer = 0)

Randomize

RandomNumbers = Round((Highest - Lowest) * Rnd + Lowest, Decimals)

End Function

opel-wong

试试：

1. Sub Macro1()
   
2.     Dim x(100), i As Integer, y, s
   
3.     For i = 1 To 100
   
4. line1:
   
5.         y = Application.Evaluate("INT(RAND()*100)+1")
   
6.         s = 0
   
7.         For j = 1 To 100
   
8.             If y <> x(j) Then s = s + 1 Else GoTo line1
   
9.         Next j
   
10.         If s = 100 Then x(i) = y
    
11.     Next i
    
12.     For i = 1 To 100
    
13.         Cells(i, 1) = x(i)
    
14.     Next i
    
15. End Sub

复制代码

opel-wong

或者这样也可以，

1. Sub 获取1至100不重复随机数()
   
2.     Range("A1").Resize(100, 1).Value = RandomNumber(1, 100, 100)
   
3. End Sub
   
4. 
   
5. Public Function RandomNumber(Minimum As Integer, Biggest As Integer, mNumber As Integer)
   
6.     If mNumber > Biggest - Minimum + 1 Then Exit Function
   
7.     Dim arr(), b() As Boolean, x As Integer, y As Integer, i As Integer
   
8.     ReDim arr(mNumber - 1)
   
9.     ReDim b(Biggest - Minimum)
   
10.     Randomize
    
11.     For i = 0 To mNumber - 1
    
12.         Do
    
13.             x = Int(Rnd * (Biggest - Minimum + 1)) + Minimum
    
14.             y = x - Minimum
    
15.         Loop While b(y)
    
16.         b(y) = True
    
17.         arr(i) = x
    
18.     Next i
    
19.     RandomNumber = Application.Transpose(arr)
    
20. End Function

复制代码

microyip

1. Sub 生成100随机数()
   
2.     Dim oDic  As Object, vKey As Variant
   
3.     Dim nI As Long, sStr As String
   
4.     Set oDic = CreateObject("Scripting.Dictionary")
   
5.     For nI = 1 To 100
   
6.         oDic(nI) = 0
   
7.     Next
   
8.     nI = 10 '取10个随机数
   
9.     Do While nI > 0 And oDic.Count > 0
   
10.         If sStr <> "" Then sStr = sStr & "，"
    
11.         vKey = oDic.Keys()(Int(Rnd() * oDic.Count))
    
12.         oDic.Remove vKey
    
13.         sStr = sStr & vKey
    
14.         nI = nI - 1
    
15.     Loop
    
16.     MsgBox "随机数：" & Chr(13) & sStr
    
17. End Sub

复制代码

LIWENHUI2002970

FOB_FN_L 发表于 2020-3-10 07:55
Option Explicit
Function RandomNumbers(Lowest As Double, Highest As Double, _
Optional Decimals As ...

你好，你这个怎么使用？？麻烦你教教我使用

vic9

Sub 生成20个1到100的不重复的随机数()
Dim i, r, D, ky, numb, n
    Columns("a").Clear
    Set D = CreateObject("scripting.dictionary")
    For i = 1 To 100
        numb = Application.WorksheetFunction.RandBetween(1, 100)
        D(numb) = ""
        If D.Count > 19 Then Exit For
    Next
        ky = D.keys
    For i = 1 To D.Count
        n = n + 1
        Sheet1.Cells(n, 1) = ky(i - 1)
    Next
End Sub

FOB_FN_L

LIWENHUI2002970 发表于 2020-3-10 08:40
你好，你这个怎么使用？？麻烦你教教我使用

用法参照6楼，只是自定义函数和6楼不一样，自定义函数的调用就是6楼那样~~~~