Live-Forum - Die aktuellen Beiträge
Datum
Titel
17.04.2024 21:55:37
Preiserhöhung über mehrere Jahre berechnen
17.04.2024 20:19:32
Endzeitpunkt berechnen aus d:hh:mm errechnen
17.04.2024 18:57:33
Errinnerungsfunktion
17.04.2024 16:56:58
Stunden addieren
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
936to940
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
936to940
936to940
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Auslosung -> Turnier

Auslosung -> Turnier
31.12.2007 17:00:00
Yannik
Hallo liebe Excel Profis :),
Ich habe ein Problem und zwar möchte ich gerne in Spalte A bis zu 20 Mannschaften eintragen, die per Mausklick auf den "Auslosen" Button in die vordefinierten Stellen der Gruppen eingeteilt werden sollen.
Schön wäre es wenn es ein wenig dauert und zuvor die Mannschaftsnamen schnell hintereinander durch ein Feld blättern und dann nach 2-3 sek. blättern plötzlich ein Wert in die Gruppenliste eingetragen wird... ist sehr schwer zu erklären daher habe ich mal eine Beispieldatei angefertigt...

Die Datei https://www.herber.de/bbs/user/48732.xls wurde aus Datenschutzgründen gelöscht


Ich könnte mir vorstellen das es ein ziemlicher Aufwand ist, daher hoffe ich das mir jemand helfen kann.
Vielen dank im vorraus :)
Gruss Yannik
Hinweis: Habe über die Suche und Mr. Google leider nichts entsprechendes finden können.

23
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Auslosung -> Turnier
31.12.2007 17:46:00
Matthias
Hallo Yannik
Beispiel (Teillösung)
https://www.herber.de/bbs/user/48734.xls
hilft's ein Stück weiter?
Da ich nicht weiß, ob ich heute nochmal reinschaue
Userbild
Userbild

AW: Auslosung -> Turnier
31.12.2007 18:20:15
Yannik
Hallo Matthias!
Ja danke, ist schonmal ein sehr schöner Anfang...
Kann man das ganze noch etwas langsamer ablaufen lassen? also das der gesamte Prozess etwas länger dauert damit es optisch etwas mehr hermacht?
Auch dir/euch natürlich einen guten Rutsch!
Aber Vorsicht bei uns friert es draußen schon :)
Gruss Yannik

Anzeige
AW: Auslosung -> Turnier
31.12.2007 18:14:37
Josef
Hallo Yanni,
diesen Code unter CommandButton1_Click.
' **********************************************************************
' Modul: Tabelle1 Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************

Option Explicit

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private Sub CommandButton1_Click()
Dim a As Variant, b As Variant, rng As Range
Dim c As Long, e As Long
Dim i As Integer, j As Integer, k As Integer, l As Integer, m As Integer, n As Integer

e = Application.Max(3, Cells(Rows.Count, 1).End(xlUp).Row)

a = Range("A3:A" & e)
a = Application.Transpose(a)
b = a
Set rng = Range("E5:E28")
n = rng.Count
rng.ClearContents
l = UBound(a)

Randomize Timer

For c = 1 To n
    
    For m = 1 To l
        Range("C3") = b(m)
        Sleep 50 'zeitverzögerung - anpassen
    Next
    
    Range("C3").ClearContents
    
    j = Int((UBound(a)) * Rnd + 1)
    
    Do
        k = Int((n) * Rnd + 1)
    Loop While rng(k, 1) <> "" Or IsNumeric(Application.Match(k, Array(5, 10, 15, 20), 0))
    
    rng(k, 1) = a(j)
    a(j) = a(UBound(a))
    
    If UBound(a) > 1 Then
        Redim Preserve a(UBound(a) - 1)
    Else
        Exit For
    End If
    
Next

Set rng = Nothing
End Sub

Gruß Sepp

Anzeige
AW: Auslosung -> Turnier
31.12.2007 18:23:36
Yannik
Oh Halle Sepp,
habs gerade erst gesehen.
Danke schonmal! werde es schnell mal ausprobieren.
Gruss Yannik

AW: Auslosung -> Turnier
31.12.2007 18:27:00
Yannik
Ja vielen dank!!
Es ist fast perfekt.
Vielleicht kam es in meinem Beispiel ein wenig falsch rüber, allerdings fände ich es schon besser wenn die Gruppen von oben nach unten ausgefüllt werden...
Auch wenn das jetzt schon eine sehr gute Lösung ist :)
Vielen dank nochmal!
Gruss Yannik

AW: Auslosung -> Turnier
31.12.2007 18:42:00
Josef
Hallo Yannik,
dann so.
' **********************************************************************
' Modul: Tabelle1 Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************

Option Explicit

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private Sub CommandButton1_Click()
Dim a As Variant, b As Variant, rng As Range
Dim c As Long, e As Long, dblSleep As Double
Dim i As Integer, j As Integer, k As Integer, l As Integer, m As Integer, n As Integer

e = Application.Max(3, Cells(Rows.Count, 1).End(xlUp).Row)

a = Range("A3:A" & e)
a = Application.Transpose(a)
b = a
Set rng = Range("E5:E28")
n = rng.Count
rng.ClearContents
l = UBound(a)

Randomize Timer

For c = 1 To n
    
    dblSleep = Now + TimeSerial(0, 0, 2)
    
    Do
        For m = 1 To UBound(a)
            Range("C3") = a(m)
            Sleep 100
            If Now > dblSleep Then Exit Do
        Next
    Loop
    
    Range("C3").ClearContents
    
    j = Int((UBound(a)) * Rnd + 1)
    
    k = k + 1
    If IsNumeric(Application.Match(k, Array(5, 10, 15, 20), 0)) Then k = k + 1
    
    rng(k, 1) = a(j)
    a(j) = a(UBound(a))
    
    If UBound(a) > 1 Then
        Redim Preserve a(UBound(a) - 1)
    Else
        Exit For
    End If
    
Next

Set rng = Nothing
End Sub

Gruß Sepp

Anzeige
AW: Auslosung -> Turnier
31.12.2007 18:46:00
Yannik
Oh ja vielen vielen dank genau das habe ich gesucht :)
Tut mir leid wegen der Mehrarbeit durch die unklare Beschreibung!
Guten Rutsch und nochmal danke an alle!
Gruss Yannik

@ Yannik - kleiner Fehler
31.12.2007 18:56:16
Josef
Hallo Yannik,
im vorherigen Code ist noch ein Fehler, nimm diesen hier.
' **********************************************************************
' Modul: Tabelle1 Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************

Option Explicit

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private Sub CommandButton1_Click()
Dim a As Variant, b As Variant, rng As Range
Dim c As Long, e As Long, dblSleep As Double
Dim i As Integer, j As Integer, k As Integer, l As Integer, m As Integer, n As Integer

e = Application.Max(3, Cells(Rows.Count, 1).End(xlUp).Row)

a = Range("A3:A" & e)
a = Application.Transpose(a)
b = a
Set rng = Range("E5:E28")
n = rng.Count
rng.ClearContents
l = UBound(a)

Randomize Timer

For c = 1 To n
    
    dblSleep = Now + TimeSerial(0, 0, 1)
    
    Do
        For m = 1 To UBound(a)
            Range("C3") = a(m)
            Sleep 100
            If Now > dblSleep Then Exit Do
        Next
    Loop
    
    Range("C3").ClearContents
    
    j = Int((UBound(a)) * Rnd + 1)
    
    k = k + 1
    If IsNumeric(Application.Match(k, Array(5, 10, 15, 20), 0)) Then k = k + 1
    
    rng(k, 1) = a(j)
    a(j) = a(UBound(a))
    
    If UBound(a) > 1 Then
        Redim Preserve a(1 To UBound(a) - 1)
    Else
        Exit For
    End If
    If c > n - 5 Then Exit For
Next

Set rng = Nothing
End Sub

Gruß Sepp

Anzeige
AW: @ Sepp - kleiner Fehler
31.12.2007 19:16:00
Yannik
Ja ich wollte gerade fragen warum er Mannschaft eins immer durch Mannschaft elf ersetzt :) aber gut jetzt scheint es zu funktionieren danke nochmal!
Gruss Yannik

AW: Auslosung -> Turnier
31.12.2007 18:26:22
Beate
Hallo,
hier eine Lösung mit Sleep (meine Lösung war gerade fertig und ich habe keine Zeit mehr, um mir die bereits vorliegenden Lösungen anzuschauen):
https://www.herber.de/bbs/user/48736.xls
Gruß,
Beate

AW: Auslosung -> Turnier
31.12.2007 18:47:00
Daniel
Hi
dann auch nochmal meine Variante, ich hoffe, sie gefällt
https://www.herber.de/bbs/user/48737.xls
Gruß, Daniel

Anzeige
AW: Auslosung -> Turnier
01.01.2008 15:19:00
Yannik
Wo wir gerade so schön dabei sind :)
Ich hätte dann doch noch eine bitte... kann jemand Daniels Version dahingehend verändern, dass man zunächst eine Checkbox aktivieren muss die nach dem losen automatisch wieder deaktiviert wird? Damit man nicht aus versehen auf den Losknopf kommt und alles durchgemischt wird. Praktisch eine Sicherheitsabfrage.
Danke im vorraus!

AW: Auslosung -> Turnier
01.01.2008 21:17:00
Daniel
Hi
meinst du so?
https://www.herber.de/bbs/user/48750.xls
ich hab jetzt allerding den Wunsch von Fritz mit einbaut, du kannst aber auch deine Datei einfach erweitern:
- Checkbox ins Blatt einfügen mit diesem Code:

Private Sub CheckBox1_Click()
CommandButton1.Enabled = CheckBox1
End Sub


- im Hauptmakro am Ende diese Zeile einfügen:


Checkbox1.Value = False


damit wird automatisch das obige Makro aufgerufen und der Button wird deaktiviert.
Gruß, Daniel

Anzeige
AW: Auslosung -> Turnier
01.01.2008 21:32:33
Yannik
Perfekt! vielen Dank hast mir wirklich sehr geholfen :)
Gruss Yannik

AW: Auslosung -> Turnier
31.12.2007 19:17:00
Yannik
Hallo Beate, Hallo Daniel
auch eure Lösungen sehen gut aus... werde mal schauen welche ich letztendlich nehme.. vielen Dank nochmal an alle!
Gruss Yannik
p.s. Guten Rutsch!

Auslosung -> Turnier - 4 Teams gesetzt
01.01.2008 11:29:58
Fritz_W
Hallo Forumsbesucher,
zunächst wünsche ich euch allen ein gutes Neues Jahr.
Könnte man einen der vorliegenden Lösungsvorschläge dahingehend erweitern, dass zunächst die 5 ersten in der Liste aufgeführten Teams als "Gruppenköpfe" auf die 5 Gruppen verteilt und die restlichen Mannschaften nach dem Zufallsprinzip den einzelnen Gruppen zulost?
Viielen Dank im voraus.
mfg
Fritz

Anzeige
schau Dir Beate's Beispiel an ! oT
01.01.2008 12:14:00
Matthias

AW: schau Dir Beate's Beispiel an ! oT
01.01.2008 12:47:15
Fritz_W
Hallo Matthias,
vermutlich habe ich mein Anliegen nicht genau genug beschrieben.
Ich möchte, dass die ersten 5 Mannschaften, die in der (Auswahl-)Liste aufgeführt sind, den jeweiligen Gruppen A bis E zugeordnet werden, also Mannschaft 1 als erstes Team in Gruppe A, Mannschaft 2 als erstes Team in Gruppe B usw.
Sinn des Ganzen ist, dass keine dieser Mannschaften in eine gemeinsame Gruppe kommen sollten.
Gruß
Fritz

AW: schau Dir Beate's Beispiel an ! oT
01.01.2008 15:01:26
Daniel
Hi
dann schau dir mal das hier an.
ich habs so geschrieben, daß das Makro recht flexibel ist, dh bei einer Änderung der Tuniergrösse (Gruppengrösse, Anzahl der Gruppe, Anzahl der Mannschaften) brauchst du nur die Konstanten im Programmkopf entsprechend zu ändern.
die ersten Manschaften sind geseztet, dh. sie werden immer als erstes auf die Gruppen verteilt.
im 2. Makro hab ich alles rausgeschmissen was reine Show ist, damit du den Programmkern siehst.
die Spalte B sollte nicht gelöscht werden, da sie sie Zufallszahlen für die Auslosung enthält.
Gruß, Daniel
https://www.herber.de/bbs/user/48745.xls

Anzeige
AW: schau Dir Beate's Beispiel an ! oT
01.01.2008 15:48:03
Fritz_W
Hallo Daniel,
ein Laie wie ich kann einfach nur staunen, was ihr Experten alles könnt.
Einfach spitze!
Vielen Dank und schönen Neujahrstag noch
Gruß
Fritz

Kombination beider Dateien
04.01.2008 19:37:32
Fritz_W
Hallo VBA-Experten,
wie lässt sich der Code in Daniels Datei dahingehend erweitern (verändern), dass durch die zweite Befehlsschaltfläche nicht eine "Auslosung ohne Show" ausgelöst wird, sondern die Auslosung mit Show dahingehend geändert wird, dass bei der Auslosung keine Mannschaften "gesetzt" sind, der Code aber durch seine Flexiblilität (Konstanten) behält.
Vielen Dank für eure Hilfen
Gruß
Fritz
https://www.herber.de/bbs/user/48803.xls

Anzeige
AW: schau Dir Beate's Beispiel an ! oT
01.01.2008 15:50:35
Fritz_W
Hallo Beate,
funktioniert bestens.
Auch Dir vielen Dank und einen schönen Neujahrstag.
Gruß
Fritz

Links zu Excel-Dialogen

CheckBox CommandButton

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige