You guys are awesome....
@Merri:
Output of Merri's code in my PC:
Did you noticed that the 4th row is showing the same result (27) !Code:72 64 53 27 86 31 81 33 68 85 45 42 77 39 54 27 12 55 24 35 53 73 89 5 68 28 60 27 29 52 36 46 47 26 20 14 54 63 60 27 11 53 12 47 56 4 25 49 84 85 60 27 32 82 54 47 8 50 41 39 41 18 62 27 63 6 88 49 79 73 25 83 2 41 62 27 35 75 40 50 68 9 28 74 60 5 63 27 22 31 54 51 65 68 35 90 77 51 63 27 26 76 52 53 33 78 14 79 11 75 63 27 37 83 5 53 46 44 60 69 6 3 64 27 58 82 39 53 1 12 7 44 72 15 64 27 65 3 66 53 6 16 69 89 83 29 64 27 56 71 90 53 59 80 40 50 64 49 65 27 58 26 38 54 45 71 44 31 36 61 64 27 7 40 60 54 62 28 41 73 49 70 64 27 26 69 77 54 22 19 25 16
@EdgeMeal:
It took 124 seconds without any modification and 134 seconds when I used DoEvents like this:
...Code:'... '..... '...... ' if no match then add to UniqArray If i > UBound(UniqArray) Then UniqArray(n) = sTmp DoEvents List1.AddItem sTmp n = n + 1 ' increment position for UniqArray '...... '.... '..
I'll test my code now...
Ah! The test result is: 241 seconds for 31999 sequences![]()
Tested code:
I think its time for upgrading my PC...Code:Option Explicit Private Sub Command1_Click() Dim OutputArray(11) As Byte '~~~ This will hold the numbers generated using the function Dim strUni(31999) As String Dim strOutput As String '~~~ Final result Dim strTemp As String Dim n As Long Dim i As Long Dim t As Single t = Timer Do While n < 31999 If n > 0 Then strTemp = StrConv(OutputArray, vbUnicode) '~~~ Getting the unicode string for the generated array values i = 0 Do While i < 31999 '~~~ We are going to check this unicode value with others. If strTemp = strUni(i) Then '~~~ If it is matched, then the array is shuffled and the checking is restarted. ShuffleArray OutputArray '~~~ Shuffle the array strTemp = StrConv(OutputArray, vbUnicode) '~~~ Unicode value of the shuffled array i = 0 '~~~ Start the checking (loop) from the beginning Else i = i + 1 End If Loop End If strUni(n) = mySequence(OutputArray) '~~~ Storing the unicode string of the present byte array values '~~~ Creating that line of sequence of the present byte array values For i = 0 To 11 strOutput = strOutput & " " & OutputArray(i) Next List1.AddItem strOutput strOutput = "" n = n + 1 Loop MsgBox Timer - t & " - " & List1.ListCount End Sub Private Function mySequence(ByRef myOrder() As Byte) As String Randomize Dim myArray(1 To 90) As Boolean Dim num As Byte Dim counter As Integer Do While counter < 12 '~~~ 12 values (for each line) num = Int(Rnd * 90 + 1) '~~~ Finding a random number from 1 to 90 If myArray(num) = False Then '~~~ Check if it is already selected myArray(num) = True '~~~ Marking it as selected number myOrder(counter) = num '~~~ Storing the number counter = counter + 1 End If Loop mySequence = StrConv(myOrder, vbUnicode) '~~~ Returning the unicode value of this byte array End Function ' Knuth shuffle (very fast). Thanks to "Ellis Dee" for this shuffle code Public Function ShuffleArray(pvarArray As Variant) Dim i As Long Dim iMin As Long Dim iMax As Long Dim lngReplace As Long Dim varSwap As Variant iMin = LBound(pvarArray) iMax = UBound(pvarArray) For i = iMax To iMin + 1 Step -1 lngReplace = Int((i - iMin + 1) * Rnd + iMin) varSwap = pvarArray(i) pvarArray(i) = pvarArray(lngReplace) pvarArray(lngReplace) = varSwap Next End Function![]()






Reply With Quote