Gruppendiskussion mit Tischwechsel

Question

Hallo zusammen,

aufgrund meiner diversen guten Erfahrungen mit Euch als Problemlösern, habe ich heute mal wieder eine kleine Excel Knobelaufgabe:

Ich habe 5 Tische A, B, C, D, E und 25 Personen 1-25. Wir spielen 5 Spielrunden S1, S2, S3, S4 und S5.

Jede Person soll während der 5 Runden genau EINMAL an jedem Tisch sitzen.

Dabei sollen die Personen möglichst gut durchgemischt werden, d.h. möglichst selten zusammen an einem Tisch sitzen.

Die genaue mathematische Umsetzung ist für mich weniger wichtig als eine praktikable Lösung, also wenn jemand z.B. das ganze per Zufall lösen kann, wäre das in Ordnung für mich.

Grüße und Danke schonmal,
markchili

Answer 1

hi kauz ^^

wir wollten flexibel bleiben

unbestimmte anzahl von spielern wie tischen

und eine simple niederschreibung ist kein loesungsansatz

gruss nighty

hab leider nicht mehr so die zeit,durch krankheit und verbote ^^

in meinem makro war glaub ich auch noch ein fehler,lange nix gemacht :-))

fuer dreier gruppen muesste man ein neues makro schreiben

Answer 2

Wie Verbote?
Hast Du geheiratet oder hast ne Sehnenscheidenentzündung?

Answer 3

Hallöle....
hab auch mal versucht mich der Problemstellung mit VBA zu nähern:

@ nighty... (AW31)... Du bist mitschuldig :-)
aber der eigentlich Schuldige ist der Ehrgeiz! :-) :-)

So, nu aber zum Thema:

Ich bin zu der Überzeugung gekommen, das es ohne nachfolgende Einschränkungen nicht machbar ist:

1. Wenn im Laufe der Spielrunden jeder Mitspieler nur einmal an jeden Tisch sitzt, so werden einige Spieler mehrmals zusammensitzen.

2. Wenn es bei der Zusammensetzung der Spieler keine Wiederholungen gibt, so werden nicht alle Spieler alle Tische durchlaufen.
(hier gibt es dann 5 Spieler, die immer an dem gleichen Tisch sitzen)
Das ist auch der Stand meines Code's.

Bedingungen: In A3 steht die Anzahl der Stühle pro Tisch.
Anzahl der Stühle = Anzahl der Spielrunden(Tische)
Anzahl der Spieler = Anzahl Stühle * Anzahl Tische

Anzahl der Stühle für's generieren steht in A3
In A1 wird die Anzahl der letzten Generierung abgelegt... für's leeren vor erneutem generieren.

Nach vielen Tassen Kaffee und vielen Raucherpausen kam dann folgendes heraus:
(Von Zeit wollen wir hier ja nicht reden... macht ja Spasss!!)

Option Explicit
Dim AnzStuehle As Integer
Dim i As Integer
Dim j As Integer
Dim k As Integer

Private Sub CommandButton1_Click()
' ------------ anzahl Stühle pro Tisch kontrollieren -----------
If ActiveSheet.Cells(3, 1) = "" Then ActiveSheet.Cells(3, 1) = 5
AnzStuehle = ActiveSheet.Cells(3, 1) '-------- neue Vorgabe der Stuhlanzahl
ReDim Feld(AnzStuehle + 1, AnzStuehle * AnzStuehle * 3)
k = ActiveSheet.Cells(1, 1) '-------- vorherige Anzahl der Stühle
If k = 0 Then k = 5
' --------- alte Maske entfernen ---------------
ActiveSheet.Range(Cells(9, 2), Cells(11 + k, 11 + k * k)).Borders(xlEdgeLeft).LineStyle = xlNone
ActiveSheet.Range(Cells(9, 2), Cells(11 + k, 11 + k * k)).Borders(xlEdgeTop).LineStyle = xlNone
ActiveSheet.Range(Cells(9, 2), Cells(11 + k, 11 + k * k)).Borders(xlEdgeBottom).LineStyle = xlNone
ActiveSheet.Range(Cells(9, 2), Cells(11 + k, 11 + k * k)).Borders(xlEdgeRight).LineStyle = xlNone
ActiveSheet.Range(Cells(9, 2), Cells(11 + k, 11 + k * k)).Borders(xlInsideVertical).LineStyle = xlNone
ActiveSheet.Range(Cells(9, 2), Cells(11 + k, 11 + k * k)).Borders(xlInsideHorizontal).LineStyle = xlNone
ActiveSheet.Range(Cells(7, 1), Cells(11 + k, 11 + k * k)).ClearContents
' ---------------- Grundmaske ------------------
ActiveSheet.Cells(1, 1).Font.ColorIndex = 2
ActiveSheet.Cells(2, 1) = "Anzahl pro Tisch:"
' ---------- erste Spalte ----------------
ActiveSheet.Columns(1).ColumnWidth = 10
' ---------- alle weiteren Spalte im Bereich ----------------
For i = 1 To AnzStuehle * AnzStuehle
ActiveSheet.Columns(i + 1).ColumnWidth = 3
Next i
ActiveSheet.Rows(10).RowHeight = 35
' -------------- Beschriftungen ------------------
For i = 0 To AnzStuehle - 1
ActiveSheet.Cells(7, 3 + i * AnzStuehle) = "Runde " & i + 1
ActiveSheet.Cells(11 + i, 1) = "Stuhl-Nr. " & i + 1
For j = 1 To AnzStuehle
ActiveSheet.Cells(10, 1 + j + i * AnzStuehle) = "T-Nr. " & j
ActiveSheet.Cells(10, 1 + j + i * AnzStuehle).Orientation = 90
ActiveSheet.Cells(10, 1 + j + i * AnzStuehle).Borders(xlEdgeLeft).Weight = xlThin
Next j
Next i
' ------------- Rahmen setzen ---------------------
For i = 0 To AnzStuehle - 1
ActiveSheet.Range(Cells(11, 2 + i * AnzStuehle), Cells(11 + AnzStuehle - 1, 1 + (i + 1) * AnzStuehle)).Borders(xlEdgeLeft).Weight = xlThick
ActiveSheet.Range(Cells(11, 2 + i * AnzStuehle), Cells(11 + AnzStuehle - 1, 1 + (i + 1) * AnzStuehle)).Borders(xlEdgeTop).Weight = xlThick
ActiveSheet.Range(Cells(11, 2 + i * AnzStuehle), Cells(11 + AnzStuehle - 1, 1 + (i + 1) * AnzStuehle)).Borders(xlEdgeBottom).Weight = xlThick
ActiveSheet.Range(Cells(11, 2 + i * AnzStuehle), Cells(11 + AnzStuehle - 1, 1 + (i + 1) * AnzStuehle)).Borders(xlEdgeRight).Weight = xlThick
ActiveSheet.Range(Cells(11, 2 + i * AnzStuehle), Cells(11 + AnzStuehle - 1, 1 + (i + 1) * AnzStuehle)).Borders(xlInsideVertical).Weight = xlThin
ActiveSheet.Range(Cells(11, 2 + i * AnzStuehle), Cells(11 + AnzStuehle - 1, 1 + (i + 1) * AnzStuehle)).Borders(xlInsideHorizontal).Weight = xlThin
Next i
' ------------ Array füllen ----------------------------------
For j = 0 To AnzStuehle - 1
For k = 0 To AnzStuehle + AnzStuehle
For i = 1 To AnzStuehle
Feld(j + 1, i + k * AnzStuehle) = i + AnzStuehle * j
Next i
Next k
Next j
' ----------------------------- array ausgeben ------------------
For j = 1 To AnzStuehle
For i = 1 To AnzStuehle * AnzStuehle
ActiveSheet.Cells(10 + j, i + 1) = Feld(j, i)
Next i
Next j
' ---------------- Reihe 2 bis X ab Runde 2 um eins+x verschieben ----------
k = 1
Do
For j = 0 To AnzStuehle - 2
For i = 1 To AnzStuehle
Feld(1 + k, i + AnzStuehle + j * AnzStuehle) = Feld(1 + k, i + AnzStuehle + j * k + k + j * AnzStuehle)
ActiveSheet.Cells(11 + k, i + j * AnzStuehle + AnzStuehle + 1) = Feld(1 + k, i + AnzStuehle + j * k + k + j * AnzStuehle)
Next i
Next j
k = k + 1
Loop While k < AnzStuehle
' ######################### geht nicht!!!!!!####################################
' ---------------- 1.Reihe ab Runde 2 um eins entgegengesetzt verschieben ----------
' For j = 0 To AnzStuehle - 2 '- 2 To 0 Step -1
' For i = 1 To AnzStuehle ' To 1 Step -1
' Feld(1, i + AnzStuehle + j * AnzStuehle) = Feld(1, i + AnzStuehle - j + 4 + j * AnzStuehle)
' ActiveSheet.Cells(11, i + j * AnzStuehle + AnzStuehle + 1) = Feld(1, i + AnzStuehle - j + 4 + j * AnzStuehle)
' Next i
' Next j
' ---------- Anzahl merken zum leeren ----------------
ActiveSheet.Cells(1, 1) = AnzStuehle
End Sub

Wenn man die letzten beiden Schleifen mitlaufen läßt, kommt es zu wiederholten Paarungen.

An einem Prog, das beide Nachteile in der Waage auspendelt, bin ich gescheitert... ich geb's zu.

Viel Spassss beim ausprobieren... ich schau auf jeden Fall noch mal hier rein.

Grüße
Kauz

Answer 4

Hallo Kauz,

vielen vielen Dank für die Arbeit die Du sicherlich hier investiert hast.
Ich bin gerade dabei es auszuprobieren und frage mich nur ob Du das Programm auf Annahme 1 oder Annahme 2 ausgerichtet hast.

1. Wenn im Laufe der Spielrunden jeder Mitspieler nur einmal an jeden Tisch sitzt, so werden einige Spieler mehrmals zusammensitzen.

2. Wenn es bei der Zusammensetzung der Spieler keine Wiederholungen gibt, so werden nicht alle Spieler alle Tische durchlaufen.
(hier gibt es dann 5 Spieler, die immer an dem gleichen Tisch sitzen)
Das ist auch der Stand meines Code's.

Grüße,
markchili

Answer 5

Hrm, also wenn ich mich nicht zu doof anstelle (kann gut sein) dann muss ich nur einen Wert vorgeben, A3, in meinem Fall 5 für 5 Spieler pro Tisch.
Wenn ich nun loslegen lassen bleiben alle 5 Runden die Spieler 1-5 auf ihrem Hintern an den gleichen Tischen sitzen.
Die anderen 4 Reihen (also Spieler 6-25) scheinen sich richtig zu verteilen.
Ich habe nun die ersten 5 Spieler mal per Hand nach dem Schema versetzt das Du vorgegeben hast und schaue das nun nochmal im Detail an.

Meine Spieler 1-5 siehen nun so aus (eigentlich nebeneinander):

1 2 3 4 5
2 3 4 5 1
3 4 5 1 2
4 5 1 2 3
5 1 2 3 4

Grüße,
markchili

Answer 6

Sorry ich nochmal,

also bis auf die ersten 5 Spieler passt das so wunderbar.
Problem ist nur das die Spieler in der ersten Runde 0 oder 5 Plätze weiterrutschen, d.h. sie sitzen wieder da wo sie zu beginn auch waren. Die Stuhlreihen 2-5 passen dadurch da sie jeweils 1-4 Plätze höher werden.

Du kannst es gerne auch mal mit mehr Personen versuchen z.B. insgesamt 5 Tische a je 6 Personen, also in Summe dann 30 Teilnehmer.
Ich habe Deine Variante jetzt mal (mit löschen der erste Reihe 1-5) verwendet um einen Test mit 4*5 Leuten zu versuchen.

Grüße,
markchili

Answer 7

Hallo markchili...

Die letzten (auskommentierten) Zeilen würden die Spieler 1 bis 5 mixen.

Das Ende des Code's so Ändern:

k = k + 1
Loop While k < AnzStuehle
' ######################### geht nicht!!!!!!####################################
' ---------------- 1.Reihe ab Runde 2 um eins entgegengesetzt verschieben ----------
For j = 0 To AnzStuehle - 2 '- 2 To 0 Step -1
For i = 1 To AnzStuehle ' To 1 Step -1
Feld(1, i + AnzStuehle + j * AnzStuehle) = Feld(1, i + AnzStuehle - j + 4 + j * AnzStuehle)
ActiveSheet.Cells(11, i + j * AnzStuehle + AnzStuehle + 1) = Feld(1, i + AnzStuehle - j + 4 + j * AnzStuehle)
Next i
Next j
' ---------- Anzahl merken zum leeren ----------------
ActiveSheet.Cells(1, 1) = AnzStuehle
End Sub

Dann wirst Du (wenn ich nichts übersehen hab) feststellen, das zwar jeder Spieler im Verlauf der 5 Runden an jeden Tisch kommt....
Dafür gibt es aber in der Zusammensetzung Wiederholungen.

Schau's Dir in Ruhe an....

Ach ja, in A3 die Anzahl der Stühle pro Tisch eintragen... die Tabelle ist damit auch flexibel.

Gruß
Kauz

Answer 8

Hallo Kauz,

ich habe es nun mal ausgiebig getestet und habe noch eine Eigenheit gefunden. Die Person in der untersten Reihe also Stuhl 5 ist immer diesselbe wie auf Stuhl Nr. 1. Es wäre doch sicherlich möglich das es nicht immer derselbe ist mit dem man dann zusammen sitzt. Das es sich nicht ganz vermeiden lässt ist klar, aber zumindest kann es ja "möglichst" wenig sein.

Was ich auch noch komisch finde ist die Eingabe von Personen pro Tisch in A3. Die Änderung der Anzahl Personen pro Tisch erhöht auch gleichzeitig die Anzahl an Tischen.

Allerdings kann ich ja auch wunderbar mit 20 Leuten pro Tisch reden, die dann trotzdem nur 5 Tische spielen.

Kann man das so gestalten das ich einzeln die Anzahl an Teilnehmer und Anzahl an Tischen festlegen kann?
Gerne kann es auch die Anzahl an Teilnehmern pro Tisch und Anzahl Tischen oder Anzahl Gesamtteilnehmer sein.

Vielen vielen Dank für Deine Bemühungen und auch die aller anderen zu dem Thema!
Ihr seid spitze!

Grüße,
markchili

Answer 9

Hallo markchili und alle Mitleser...

Hab den Code noch mal überarbeitet:
In Zelle A3 Anzahl der Stühle
In Zelle H3 Anzahl der Tische
(Wird beim ersten Starten automatisch auf 5 gesetzt)

Maximale Tischanzahl ist 15... mehr Spalten gibt's in Excel2003 nicht!

Die besten Ergebnisse gibt es wenn:

Die Stuhlanzahl kleiner als die Tischanzahl ist...
und als Tischanzahl eine ungerade Zahl genommen wird.

Hier der Code:

Option Explicit
Dim AnzStuehle As Integer
Dim AnzTische As Integer
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim T As Integer



Private Sub CommandButton1_Click()
' ------------ anzahl Stühle pro Tisch kontrollieren -----------
If ActiveSheet.Cells(3, 1) = "" Then ActiveSheet.Cells(3, 1) = 5
If ActiveSheet.Cells(3, 8) = "" Then ActiveSheet.Cells(3, 8) = 5
AnzStuehle = ActiveSheet.Cells(3, 1) '-------- neue Vorgabe der Stuhlanzahl
AnzTische = ActiveSheet.Cells(3, 8) '-------- neue Vorgabe der Tischanzahl
ReDim Feld(AnzStuehle + 1, AnzTische * (AnzTische + 1))
k = ActiveSheet.Cells(1, 1) '-------- vorherige Anzahl der Stühle
T = ActiveSheet.Cells(1, 8) '-------- vorherige Anzahl der Tische
If ActiveSheet.Cells(3, 8) > 15 Then
MsgBox "Die maximale Tischanzahl ist 15!"
Exit Sub
End If
If k = 0 Then k = 5
If T = 0 Then T = 5
' --------- alte Maske entfernen ---------------
ActiveSheet.Range(Cells(9, 2), Cells(11 + k, 11 + T * T)).Borders(xlEdgeLeft).LineStyle = xlNone
ActiveSheet.Range(Cells(9, 2), Cells(11 + k, 11 + T * T)).Borders(xlEdgeTop).LineStyle = xlNone
ActiveSheet.Range(Cells(9, 2), Cells(11 + k, 11 + T * T)).Borders(xlEdgeBottom).LineStyle = xlNone
ActiveSheet.Range(Cells(9, 2), Cells(11 + k, 11 + T * T)).Borders(xlEdgeRight).LineStyle = xlNone
ActiveSheet.Range(Cells(9, 2), Cells(11 + k, 11 + T * T)).Borders(xlInsideVertical).LineStyle = xlNone
ActiveSheet.Range(Cells(9, 2), Cells(11 + k, 11 + T * T)).Borders(xlInsideHorizontal).LineStyle = xlNone
ActiveSheet.Range(Cells(7, 1), Cells(11 + k, 11 + T * T)).ClearContents
' ---------------- Grundmaske ------------------
ActiveSheet.Cells(1, 1).Font.ColorIndex = 2
ActiveSheet.Cells(2, 1) = "Anzahl pro Tisch:"
ActiveSheet.Cells(1, 8).Font.ColorIndex = 2
ActiveSheet.Cells(2, 8) = "Anzahl der Tische:"
' ---------- erste Spalte ----------------
ActiveSheet.Columns(1).ColumnWidth = 10
' ---------- alle weiteren Spalte im Bereich ----------------
For i = 1 To AnzTische * AnzTische
ActiveSheet.Columns(i + 1).ColumnWidth = 2.86
Next i
ActiveSheet.Rows(10).RowHeight = 39
' -------------- Beschriftungen ------------------
For i = 0 To AnzTische - 1
ActiveSheet.Cells(7, 3 + i * AnzTische) = "Runde " & i + 1
For j = 1 To AnzTische
ActiveSheet.Cells(10, 1 + j + i * AnzTische) = "T-Nr. " & j
ActiveSheet.Cells(10, 1 + j + i * AnzTische).Orientation = 90
ActiveSheet.Cells(10, 1 + j + i * AnzTische).Borders(xlEdgeLeft).Weight = xlThin
Next j
Next i
For i = 1 To AnzStuehle
ActiveSheet.Cells(10 + i, 1) = "Stuhl-Nr. " & i
Next i
' ------------- Rahmen setzen ---------------------
For i = 0 To AnzTische - 1
ActiveSheet.Range(Cells(11, 2 + i * AnzTische), Cells(11 + AnzStuehle - 1, 1 + (i + 1) * AnzTische)).Borders(xlEdgeLeft).Weight = xlThick
ActiveSheet.Range(Cells(11, 2 + i * AnzTische), Cells(11 + AnzStuehle - 1, 1 + (i + 1) * AnzTische)).Borders(xlEdgeTop).Weight = xlThick
ActiveSheet.Range(Cells(11, 2 + i * AnzTische), Cells(11 + AnzStuehle - 1, 1 + (i + 1) * AnzTische)).Borders(xlEdgeBottom).Weight = xlThick
ActiveSheet.Range(Cells(11, 2 + i * AnzTische), Cells(11 + AnzStuehle - 1, 1 + (i + 1) * AnzTische)).Borders(xlEdgeRight).Weight = xlThick
ActiveSheet.Range(Cells(11, 2 + i * AnzTische), Cells(11 + AnzStuehle - 1, 1 + (i + 1) * AnzTische)).Borders(xlInsideVertical).Weight = xlThin
ActiveSheet.Range(Cells(11, 2 + i * AnzTische), Cells(11 + AnzStuehle - 1, 1 + (i + 1) * AnzTische)).Borders(xlInsideHorizontal).Weight = xlThin
Next i
' ------------ Array füllen ----------------------------------
For j = 0 To AnzStuehle - 1
For k = 0 To AnzTische
For i = 1 To AnzTische
Feld(j + 1, i + k * AnzTische) = i + AnzTische * j
Next i
Next k
Next j
' ----------------------------- array ausgeben ------------------
For j = 1 To AnzStuehle
For i = 1 To AnzTische * AnzTische
ActiveSheet.Cells(10 + j, i + 1) = Feld(j, i)
Next i
Next j
' ---------------- Reihe 2 bis X ab Runde 2 um eins+x verschieben ----------
k = 1
Do
For j = 0 To AnzTische - 2
For i = 1 To AnzTische
ActiveSheet.Cells(11 + k, i + j * AnzTische + AnzTische + 1) = Feld(1 + k, i + j * k + k)
Next i
Next j
k = k + 1
Loop While k < AnzStuehle
' ---------------- 1.Reihe ab Runde 2 um eins entgegengesetzt verschieben ----------
For j = 0 To AnzTische - 2 '- 2 To 0 Step -1
For i = 1 To AnzTische ' To 1 Step -1
ActiveSheet.Cells(11, i + j * AnzTische + AnzTische + 1) = Feld(1, i + AnzTische - j + AnzTische - 1 + j * AnzTische)
Next i
Next j
' ---------- Anzahl merken zum leeren ----------------
ActiveSheet.Cells(1, 1) = AnzStuehle
ActiveSheet.Cells(1, 8) = AnzTische
End Sub

So, dann mal viel Spasss beim Testen....

Gruß
Kauz

Answer 10

Hallo Kauz,

Du bist brilliant!

Ich konnte bei allen getesten Varianten keinen Fehler mehr finden.

Super Jungs, ihr seid echt spitze!

Ich hätte nie gedacht das das jemand so hinbekommt.

Um das ganze jetzt auch wirklich nutzen zu können fehlen mir natürlich noch Kärtchen die ich den Teilnehmern in die Hand drücken kann auf denen pro
Spielrunde der jeweils richtige Tisch vermerkt ist.

Also für jeden Spieler einen Zettel sozusagen auf dem untereinander pro Runde der Tisch steht.

Spieler Nr. 1
Runde 1 Tisch 4
Runde 2 Tisch 2
Runde 3 Tisch 3
Runde 4 Tisch 1

Spieler Nr. 2
etc.

Ist das machbar?

Ich kämpfe schon seit ein paar Stunden mit Sverweis, Wverweis und Wenndann, aber ich glaube da komme ich so nicht weiter.
Vorallem nicht da ja alles variabel ist.

Kann man das auch noch hinbekommen?

Grüße und vielen vielen Dank schonmal,
markchili