余小章 @ 大內殿堂

'比對法

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 myRand2()

    Dim StartTime As Date

    Dim TemArray() As Long, DataArray() As Long

    Dim Con As Long '數量

    Dim RowCon As Long, ColCon As Long, ChangeCon As Long

    Dim i As Long, j As Long, k As Long  '迴圈

    Dim x1 As Long, y1 As Long, z1 As Long

    Dim x2 As Long, y2 As Long, z2 As Long

    Dim x3 As Long, y3 As Long, z3 As Long

    Cells.Clear

    RowCon = 100

    ColCon = 100

    Con = RowCon * ColCon

    ChangeCon = Con * 100

    StartTime = Timer

    '產生亂數

    ReDim TemArray(Con) As Long

    For i = 1 To Con

        TemArray(i) = i

    Next i

    '六張牌交換法

    '================================================

    For i = 1 To ChangeCon '交換次數

        Randomize Timer

        x1 = Int(Con * Rnd + 1) '產生亂數index

        y1 = Int(Con * Rnd + 1)

        x2 = Int(Con * Rnd + 1)

        y2 = Int(Con * Rnd + 1)

        x3 = Int(Con * Rnd + 1)

        y3 = Int(Con * Rnd + 1)

        'x跟y交換

        z1 = TemArray(x1)

        TemArray(x1) = TemArray(y1)

        TemArray(y1) = z1

        z2 = TemArray(x2)

        TemArray(x2) = TemArray(y2)

        TemArray(y2) = z2

        z3 = TemArray(x3)

        TemArray(x3) = TemArray(y3)

        TemArray(y3) = z3

    Next i

    '順序交換，重第一個陣列開始交換，不夠亂!!!

    '================================================

'    For i = 1 To Con  '交換次數

'        Randomize Timer

'        y1 = y1 + 1

'        x1 = Int(Con * Rnd + 1) '產生x亂數index

'        z1 = TemArray(x1) '交換

'        TemArray(x1) = TemArray(y1)

'        TemArray(y1) = z1

'    Next i

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

    For i = 1 To RowCon

        For j = 1 To ColCon

            k = k + 1

            DataArray(i, j) = TemArray(k)

        Next j

    Next i

    Sheets("pro").Range(Cells(1, 1), Cells(RowCon, ColCon)).Value = DataArray

    Sheets("inf").Range("A3").Value = "交換法-洗了 " & ChangeCon & "次牌 產生" & Con & " 個 亂數排列，花費： " & Format(Timer - StartTime, "00.00") & " 秒."

End Sub