m4ltus
02-13-2019, 03:40 AM
Hello,
I need some help with my Excel project... My goal is to shuffle for example F26 to F45 with the fisher yates algorithm and put them shuffled in the cells blow (F49 to F68). I found this codes but I don't know how to implement this into my sheet.
Could you please help me with this? :) Thank you for your answers!
'Fisher–Yates shuffle
Sub ShuffleArray(Data&())
Dim i&, j&, iMin&, iMax&, Swap
iMin = LBound(Data): iMax = UBound(Data)
For i = iMax To iMin + 1 Step -1
j = Int((i - iMin + 1) * Rnd + iMin)
Swap = Data(i)
Data(i) = Data(j)
Data(j) = Swap
Next i
End Sub
Option Compare Database
Option Explicit
Private m_lNextRandomId&(), m_lIndex&
Private Sub Form_BeforeUpdate(Cancel As Integer)
Dim i&, valid As Boolean
On Error GoTo NoMoreFreeNumbers
Do
i = m_lNextRandomId(m_lIndex): m_lIndex = m_lIndex + 1
With Me.RecordsetClone
Call .FindFirst(BuildCriteria("rnd_id", dbLong, i))
If .NoMatch Then valid = True
End With
Loop Until valid
Me.rnd_id = i
Exit Sub
NoMoreFreeNumbers:
Cancel = True: Me.Undo
MsgBox "Kann keinen neuen Datensatz anlegen", vbInformation, _
"Keine freie Nummer vorhanden "
End Sub
Private Sub Form_Load()
Dim i&
ReDim m_lNextRandomId(100000 To 999999)
'ReDim m_lNextRandomId(100000 To 100010) 'zum Testen
For i = LBound(m_lNextRandomId) To UBound(m_lNextRandomId)
m_lNextRandomId(i) = i
Next i
Randomize: Call ShuffleArray(m_lNextRandomId)
m_lIndex = LBound(m_lNextRandomId)
End Sub
I need some help with my Excel project... My goal is to shuffle for example F26 to F45 with the fisher yates algorithm and put them shuffled in the cells blow (F49 to F68). I found this codes but I don't know how to implement this into my sheet.
Could you please help me with this? :) Thank you for your answers!
'Fisher–Yates shuffle
Sub ShuffleArray(Data&())
Dim i&, j&, iMin&, iMax&, Swap
iMin = LBound(Data): iMax = UBound(Data)
For i = iMax To iMin + 1 Step -1
j = Int((i - iMin + 1) * Rnd + iMin)
Swap = Data(i)
Data(i) = Data(j)
Data(j) = Swap
Next i
End Sub
Option Compare Database
Option Explicit
Private m_lNextRandomId&(), m_lIndex&
Private Sub Form_BeforeUpdate(Cancel As Integer)
Dim i&, valid As Boolean
On Error GoTo NoMoreFreeNumbers
Do
i = m_lNextRandomId(m_lIndex): m_lIndex = m_lIndex + 1
With Me.RecordsetClone
Call .FindFirst(BuildCriteria("rnd_id", dbLong, i))
If .NoMatch Then valid = True
End With
Loop Until valid
Me.rnd_id = i
Exit Sub
NoMoreFreeNumbers:
Cancel = True: Me.Undo
MsgBox "Kann keinen neuen Datensatz anlegen", vbInformation, _
"Keine freie Nummer vorhanden "
End Sub
Private Sub Form_Load()
Dim i&
ReDim m_lNextRandomId(100000 To 999999)
'ReDim m_lNextRandomId(100000 To 100010) 'zum Testen
For i = LBound(m_lNextRandomId) To UBound(m_lNextRandomId)
m_lNextRandomId(i) = i
Next i
Randomize: Call ShuffleArray(m_lNextRandomId)
m_lIndex = LBound(m_lNextRandomId)
End Sub