Zufallauswahl

[Fennek]

Hallo,

hier die Version für Heimspiele UND Auswärtsspiele. Es ist "mittelmäßig" getestet.

Code:

Const Heimspiel As Integer = 20 ' bei Bedarf ändern
Dim rng As Range

Sub R_Find()

lr = Cells(Rows.Count, "A").End(xlUp).Row
With Range("B1:C" & lr)
       Set rng = .Find("ja", , , , xlColumns)
   For j = 1 To Heimspiel
       Cells(rng.Row, 4) = Cells(rng.Row, 4) + 1
       Cells(rng.Row, 4 + j) = "KG: " & IIf(rng.Column = 2, "M", "V")
       Set rng = .FindNext(rng)
     
   Next j
End With
Set rng = Range("D1:D" & lr)
y = rng.Replace("", 0)
'Trikot
Call Fuellen(2, "Trikot")
LL = Array("10 1/2 Bröt.", "Laugeng.", "Kuchen")

For Each L In LL
   Call Fuellen(1, L)
Next L
'Fahrer für Auswärtsspiele
Fahrer = Array("F1", "F2", "F3", "F4", "F5", "F6")
For j = 5 + Heimspiel To 5 + 2 * Heimspiel - 1
   Set rng = Range(Cells(2, j), Cells(lr, j))
B = WorksheetFunction.CountIf(rng, "Bus")
If B = 0 Then
f = 0
   Do
       i = i + 1
       i = i Mod lr
       i = IIf(i < 1, 1, i)
       If rng.Item(i).Value = "" Then
           rng.Item(i).Value = Fahrer(f)
           f = f + 1
       End If
   Loop Until f > UBound(Fahrer)
End If
Next j
End Sub

Sub bus()
'Cursor in Spalte des Auswärtsspiels stellen und strg-b, toogle Bus-leer

lr = Cells(Rows.Count, "A").End(xlUp).Row

Set rng = Range(Cells(2, Selection.Column), Cells(lr, Selection.Column))
B = WorksheetFunction.CountIf(rng, "Bus")
If B = 0 Then
   y = rng.Replace("", "Bus")
Else
   y = rng.Replace("Bus", "")
End If
End Sub

Function Fuellen(ByVal W As Integer, ByVal Tx As String)
For j = 1 To W * Heimspiel
Versuch:
       f = WorksheetFunction.Min(rng)
       r = WorksheetFunction.Match(f, rng, 0)
       If Cells(r, 4 + j) = "" Or Cells(r, 4 + j) = "Bus" Then
           Cells(r, 4 + j) = Tx
           Cells(r, 4) = Cells(r, 4) + 1
       Else
           Debug.Print "Fehler in " & r & j
           Cells(r, 4) = Cells(r, 4) + 1
           GoTo Versuch
       End If
   Next j
End Function
Sub loesch()
Range("D2:AR15").Clear
End Sub

Für die Tage mit Bustransfer den Cursor in die entsprechende Spalte stellen und strg-b drücken.

Zum Zurücksetzen des ganzen Bereichs: strg-l

mfg

[Uwe]

Hallo Leute,

ich bin im Moment beruflich auf Reisen und komme erst am Wochenende wieder dazu alles auszuprobieren.
Ich wollte mich nur kurz melden, weil ich nichts habe von mir hören lassen.
Vorab auf jeden Fall schon mal vielen Dank für eure Hilfe.

Grüße
Uwe

[Uwe]

Hallo zusammen,

ich habe jetzt einige Vorschläge von euch ausprobiert und in meine Datenbank eingebaut.
Es funktioniert soweit alles.

Vielen Dank an euch für eure Mühe.

Bis Bald

Grüße
Uwe