EXCEL VBA：亂數

亂數：

呼叫 Rnd 前，請使用沒有引數的 Randomize 陳述式以系統計時器做為種子來初始化亂數產生器。

不重覆的演算法還算蠻常見的，以下就用Excel來展現。

法一：比對法

'比對法

Sub myRand()

    Dim StartTime As Date

    Randomize Timer

    Dim i As Long, r As Long, j As Long, k As Long

    Dim N() As Long, M() As Long

    Dim RowCon As Long, ColCon As Integer

    Dim Con As Long

    Cells.Clear

    RowCon = 7

    ColCon = 7

    Con = RowCon * ColCon

    k = 1

    StartTime = Timer

    ReDim N(Con) As Long

    ReDim M(1 To RowCon, 1 To ColCon) As Long

    For i = 1 To Con '亂數序列中不會有相同的數字

        r = 1

        Do Until r <> 1 'r = 1 表示N(i)的亂數有重複

            N(i) = Int(Con * Rnd) + 1 '取亂數

            r = 0

            For j = 1 To i - 1

                If N(i) = N(j) Then '檢查是否重複，若重複就重取亂數

                    r = 1

                    Exit For

                End If

            Next j

        Loop

    Next i

    '陣列轉移

    For i = 1 To RowCon

        For j = 1 To ColCon

            M(i, j) = N(k)

            k = k + 1

        Next j

    Next i

    '填入工作表

    With Sheets("pro")

        .Range(Cells(1, 1), Cells(RowCon, ColCon)).Value = M

    End With

   

    Sheets("inf").Range("A1").Value = "比對法-產生" & Con & "個 亂數排列，花費： " & Format(Timer - StartTime, "00.00") & " 秒."

End Sub


法二，抽牌法

Sub myRand1()

    Dim StartTime As Date

    Dim Index() As Long, NextIndex() As Long

    Dim TraData() As Long

    Dim x As Long, y As Long, z As Long

    Dim i As Long, j As Long, k As Long

    Dim RowCon As Long, ColCon As Long

    Application.ScreenUpdating = False

    RowCon = 100

    ColCon = 100

   

    x = RowCon * ColCon '初值

    y = 0

    Cells.Clear

    ReDim Index(x) As Long '建立空的陣列

    ReDim NextIndex(x) As Long '建立空的陣列

    ReDim TraData(1 To RowCon, 1 To ColCon) As Long

    StartTime = Timer

   

    Do Until y = x

        Randomize

        z = Int(x * Rnd + 1) '產生亂數

        If Index(z) = 0 Then 'Index(z)陣列為0，表示這個位置沒有人坐

            Index(z) = 1 '把亂數代入陣列

            y = y + 1

            NextIndex(y) = z '亂數重新排列，看起來才夠亂

        End If

       

    Loop

   

    '陣列轉移

    For i = 1 To RowCon

        For j = 1 To ColCon

            k = k + 1

            TraData(i, j) = NextIndex(k)

        Next j

    Next i

   

    '填入工作表

    With Sheets("pro")

        .Range(Cells(1, 1), Cells(RowCon, ColCon)).Value = TraData

    End With

   

    Sheets("inf").Range("A2").Value = "抽牌法-" & "產生" & x & "個 亂數排列，花費： " & Format(Timer - StartTime, "00.00") & " 秒."

    Application.ScreenUpdating = True

   

End Sub



洗牌法
Sub test()
Dim x(1 To 60) As Integer
For i = 1 To 60
x(i) = i
Next
For j = 1 To 1000
a1 = Int(Rnd() * 60) + 1
a2 = Int(Rnd() * 60) + 1
temp = x(a1)
x(a1) = x(a2)
x(a2) = temp
Next
For l = 1 To 60
Cells(l, 1) = x(l)
Next
End Sub

排序法
A1=rand(), b1=rank(a1,$a$1:a$60)
拖拉放， b1:b60就是1-60隨機分派