Random nummering

[Sytse1]

Het volgende krijg ik niet voor elkaar.
Nadat in het blad Spelers in kolom A een x wordt gezet is deze regel geselecteerd.
(De selectie kan elke keer wijzigen)
Nadat de selectie gereed is moet in een vba module de volgende procedure uitgevoerd worden:
De met een x geselecteerden worden gekopieerd naar A2 in het blad geselecteerden.
De geselecteerden moeten random gesorteerd worden.
Na de sortering moet elke geselecteerden vanaf A2 een nummer krijgen te beginnen met 1.

Ik heb het op verschillende manieren geprobeerd, maar helaas.

Zie bijgaand voorbeeld.
Wie kan mij een beetje op weg helpen.

Sytse

 

[JEC.]

Run deze eens

Sub j_v()
  With Sheets(1).Cells(1).CurrentRegion
   Sheets(2).Cells(1).CurrentRegion.Offset(1).ClearContents
   .AutoFilter 1, "X"
   .Offset(1).Copy Sheets(2).Range("A2")
   .AutoFilter
  End With
 With Sheets(2)
    a = .Cells(1).CurrentRegion
    jv = Application.RandArray(UBound(a), 1)
      ReDim ar(UBound(jv))
       For i = 1 To UBound(jv)
         ar(i - 1) = Application.Match(Application.Small(jv, i), jv, 0)
       Next
     .Cells(2, 2).Resize(UBound(ar)) = Application.Transpose(ar)
     .Cells(1).CurrentRegion.Sort .Range("B2"), 1, , , , , , xlYes
 End With
End Sub

 

[cow18]

volledig in het geheugen met een gesorteerde lijst en een dictionary.
Er wordt maar 1 keer gelezen en geschreven.
Dat zou bij grotere bereiken tijdswinst opleveren, in dit geval vermoedelijk niet veel.

Sub RandomSpelers()
   Set List = CreateObject("System.Collections.ArrayList")
   Set dict = CreateObject("Scripting.Dictionary")

   Sheets("spelers").UsedRange.Columns("A").Name = "MijnX"   'gedefinieerde naam voor de A-kolom
   arr = Filter([transpose(if(mijnx="x",offset(mijnx,,1,,)&"|"&offset(mijnx,,2,,),"~"))], "~", 0, vbTextCompare)   'array met alle ID + namen die geselecteerd zijn
   If UBound(arr) = -1 Then MsgBox "foutje bedankt", vbCritical: Exit Sub   'geen namen geselecteerd = einde verhaal

   For i = 0 To UBound(arr)                      'alle namen aflopen
      List.Add Format(Rnd(), "0.000000000") & "|" & arr(i)   'toevoegen aan de list, random getal + pipe + naam
   Next
   List.Sort                                     'lijst sorteren
   arr = List.toarray                            'teruglezen naar array
   For i = 0 To UBound(arr)                      'alle namen terug aflopen
      sp = Split(arr(i), "|")                    'splitsen op de pipe
      dict.Add dict.Count, Array(dict.Count + 1, sp(1), sp(2))   'toevoegen aan dictionary, incremental number + id + naam
   Next

   With Sheets("Geselecteerden")
      .UsedRange.Offset(1).Resize(, 3).ClearContents   'vorige gegevens wissen
      .Range("A2").Resize(dict.Count, 3).Value = Application.Index(dict.items, 0, 0)   'nieuwe gegevens wegschrijven
   End With

End Sub

 

[Sytse1]

Wat zijn jullie snel, bedankt.
Ik ga er morgen meteen mee aan de slag

 

[HSV]

Ook een duit.

Sub hsv()
  With Sheets(1).Cells(1).CurrentRegion
   Sheets(2).Cells(1).CurrentRegion.Offset(1).ClearContents
    .AutoFilter 1, "X"
    .Offset(1).Copy Sheets(2).Range("A2")
    .AutoFilter
  End With
 With Sheets(2)
    sv = .Cells(1).CurrentRegion
     .Cells(2, 2).Resize(UBound(sv) - 1) = "=rand()"
     .Cells(2, 2).Resize(UBound(sv) - 1) = Evaluate("index(rank(geselecteerden!b2:b" & UBound(sv) & ",geselecteerden!b2:b" & UBound(sv) & "),)")
     .Cells(1).CurrentRegion.Sort .Range("B2"), 1, , , , , , xlYes
 End With
End Sub

 

[cow18]

mooi, die evaluate-regel !

 

[Sytse1]

Cow18,
ik ga er van uit dat je dit positief bedoeld.

 

[cow18]

natuurlijk, die ene regel charmeert me.
De regel er voor vul je de 2e kolom met random cijfers en die evaluate maakt daar een rangnummer van, knap.

 

[Sytse1]

Geweldige helpmij-hulpverleners.
Het werkt geweldig en snel.
Kan ik mij bezig gaan houden met de volgende hersenbreker.
De geselecterden gaan in paren 5 ronden tegen elkaar spelen.
In elke ronde spelen ze met een andere partner en tegen andere tegenstanders.
Afhankelijk van het aantal spelers kan het voorkomen dat het 3 tegen 2 is of drie tegen 3 is.
Maar het gezamenlijk spelen met 3 mag maar in 1 ronde voorkomen..
Ik heb dit al in tabellen 16 t/m 100 spelers uitgewerkt. 84 bladen.
Nu kijken of ik dit in vba gerealiseerd kan krijgen.
Nogmaals bedankt.
Sytse

 

[sylvester-ponte]

Sytse, leuke uitdaging, maak daar eens een nieuw draadje van aub met klein voorbeeld bestandje .

 

[Sytse1]

Ga ik doen.

Ik gebruik Windows 10 en Office 365

Sytse