oke,
je kan misschien hier al iets mee doen.
dit is de code voor een macro die dus 40 unieke cijfers plaatst in kolom A, je kan die ook wijzigen hé
je kan die koppelen aan een knop en wanneer je dan op de knop klik veranderen de nummers
Code:
Sub uniekenummers()
Randomize
For j = 1 To 40
Cells(j, 1) = Rnd
Next
[A1:A40] = [index(rank(A1:A40,A1:A40),)]
End Sub
opgelost denk ik. plaats de code in een nieuwe module van VBA in excel.
zet in "B1" het aantal deelnemers en voer de macro "uniekenummers" uit.
leuk om dit eens te testen
Code:
Const StartRij As Long = 1
Const Kolom As String = "A"
Const LaagsteWaarde As Long = 1
Public HoogsteWaarde As Long
Public Sub UniekeNummers()
HoogsteWaarde = ActiveSheet.Range("B1").Value
ActiveSheet.Range(Cells(StartRij, Kolom), Cells(StartRij + ((HoogsteWaarde - LaagsteWaarde)), Kolom)).Value = Application.Transpose(UniekeRandomNummers(LaagsteWaarde, HoogsteWaarde))
End Sub
Public Function UniekeRandomNummers(Laagste As Long, Hoogste As Long) As Variant
Dim RandomCollection As Collection, Getal As Long, UniekArray() As Long
Set RandomCollection = New Collection
UniekeRandomNummers = False
Aantal = ((Hoogste - Laagste) + 1)
ReDim UniekArray(1 To Aantal)
On Error Resume Next
'Creeer unieke getallen
Do
Getal = CLng(Rnd * (Hoogste - Laagste) + Laagste)
RandomCollection.Add Getal, CStr(Getal)
Loop Until RandomCollection.Count = Aantal
On Error GoTo 0
'Unieke gegevens copieren in Array
For Getal = 1 To Aantal
UniekArray(Getal) = RandomCollection(Getal)
Next Getal
'Gegevens teruggeven
UniekeRandomNummers = UniekArray
'Ruim op
Set RandomCollection = Nothing
Erase UniekArray
End Function
suc6
Favorieten/bladwijzers