• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Hengelwedstrijd

Status
Niet open voor verdere reacties.
C

cova1

Gebruiker
Lid geworden
12 aug 2010
Berichten
36
Er bestaat een excel bestandje waarmee je automatisch nummer kan trekken voor bijvoorbeeld een hengelwedstrijd .
Dus je zet alle deelnemers in de lijst en dan klik je op nummers trekken en elke deelnemer krijgt automatisch zijn plaatsnummer toegewezen.
Iemand iets ???
 
Met functie ASELECTUSSEN en verborgen hulpkolom. Druk op F9 voor nieuwe lijst. Handmatig berekenen staat aan.
 

Bijlagen

  • vb_Cova1 (AC).xlsx
    10,6 KB · Weergaven: 15
hengel

zoiets zie vb
 

Bijlagen

  • test.xlsx
    11 KB · Weergaven: 28
Mijn man is wedstrijdvisser en heeft regelmatig wedstrijden georganiseerd waar ook de grote vissers aan meededen.
Hij (en andere die wedstrijden organiseren) maken gewoon nummertjes, doen die in een zak en als men dan afspreekt bij de visplek of in een kantine, schud men de zak en laat men elke visser een nummertje trekken.
Hartstikke simpel maar effectief.

Maar goed, dat is geen antwoord op je vraag. Succes met vissen!!
 
Deze kan achter je knop

Code: 
Sub jec()
 Dim ar, sq, sp, j As Long
 ar = Range("A2", Range("A" & Rows.Count).End(xlUp)).Resize(, 3)
 sq = Range("B2", Range("B" & Rows.Count).End(xlUp))
 sp = Application.RandArray(UBound(sq))
   
 For j = 1 To UBound(ar)
    ar(j, 3) = sq(Application.Match(Application.Large(sp, j), sp, 0), 1)
 Next
   
 Range("A2", Range("A" & Rows.Count).End(xlUp)).Resize(, 3) = ar
End Sub
 
Hier ook nog een O365 formule optie

Code: 
=INDEX(SORTEREN.OP(B2:B19;ASELECT.MATRIX(RIJEN(B2:B19)));REEKS(RIJEN(A2:A15)))
 
foutmelding

Sub jec()
Dim ar, sq, sp, j As Long
ar = Range("A2", Range("A" & Rows.Count).End(xlUp)).Resize(, 3)
sq = Range("B2", Range("B" & Rows.Count).End(xlUp))
sp = Application.RandArray(UBound(sq))

For j = 1 To UBound(ar)
ar(j, 3) = sq(Application.Match(Application.Large(sp, j), sp, 0), 1)
Next

Range("A2", Range("A" & Rows.Count).End(xlUp)).Resize(, 3) = ar
End Sub

regel sp=application,randarry(ubond(sq))
 
Laatst bewerkt:
Welke Excel versie heb je?
Krijg je de melding op de "randarray" regel?
 
Probeer dan deze eens

Code: 
Sub jec()
 Dim ar, sq, sp, j As Long
 If Range("Z1") = Date Then Exit Sub
 ar = Range("A2", Range("A" & Rows.Count).End(xlUp)).Resize(, 3)
 sq = Range("B2", Range("B" & Rows.Count).End(xlUp))
 ReDim sp(1 To UBound(sq))
 
 Randomize
 For j = 1 To UBound(sq)
   sp(j) = Rnd
 Next
 For j = 1 To UBound(ar)
   ar(j, 3) = sq(Application.Match(Application.Large(sp, j), sp, 0), 1)
 Next
   
 Range("A2", Range("A" & Rows.Count).End(xlUp)).Resize(, 3) = ar
 Range("Z1") = Date
End Sub
 
Laatst bewerkt:
Deze doet het ,
is het mogelijk om deze slechts éénmaal daags te doen, misschien met invoeren datum in bepaalde cel?
mvg
 
Heb de code in de voorgaande post aangepast. Nu kun je 1x per dag runnen.
 
Heb systeem datum naar 26/9 gedaan , geeft aan

COMPLILEERFOUT
SYNTAXISFOUT

is dit normaal ?

grt
 
En als je dat niet doet?
 
Ook zelfde foutmelding
 

Bijlagen

  • fout.JPG
    fout.JPG
    50,7 KB · Weergaven: 114
Er staat een extra "b" achter End Sub
 
Nu doet deze het zonder fouten,
kan ik nog volgende melding krijgen als ik macro voor meerdere malen gebruik,
"plaatsen al getrokken voor vandaag"
of iets dergelijks
mvg
 
Vervang de eerste regel door deze

Code: 
If Range("Z1") = Date Then MsgBox "Plaatsen al getrokken voor vandaag", vbOKOnly: Exit Sub
 
Beste Jec

Bedankt voor de moeite ,
het is voortreffelijk,
onze vissers zullen U dankbaar zijn.

mvg
 
Graag gedaan, vang ze!
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan