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 nighty,

ja das mit den Startposition in Deinem Skript habe ich eh nicht verstanden. Da ich von dem Rest auch nur wenig Ahnung hatte, hat mich das aber nicht weiter verwundert.

Naja vielleicht schaffst Du es ja den Fehler noch zu finden, wäre super!

Merci auf jeden Fall schonmal soweit!

Grüße,
markchili

Answer 2

hi markchili ^^

registrier dich,dann koennen wie ueber email in verbindung bleiben
ich schreib dir dann eine pn (persoenliche nachricht) mit emailaddy

gruss nighty

Answer 3

hi all ^^

email adresse

oberley@t-online.de

[sup]*xxxxxxxxx*[/sup]

gruss nighty

[*][sup]
*Threadedit* 01.03.2009, 10:56:50
Admininfo: siehe die SN Nutzungsbedingungen.[/sup]

Answer 4

hi all ^^

momentane stand :-)

gruss nighty

wenn die namensliste durch die anzahl der tische teilbar ist und dieses ergebnis an runden gespielt wird, entsteht ein optimum der mischung

ansonsten wird jede mischreihenfolge verkuerzt bzw wiederholt

vorraussetzungen

spalte A
ab A2 beginnend eine namensliste,beliebig lang

spalte B
B2 anzahl runden

Option Explicit
Sub SpielerRunde()
Range(Cells(1, 3), Cells(ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row, ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Column)) = ""
Randomize Timer
Dim ZeilenA As Long
Dim AnzTische As Integer, SpielerRaus As Integer, endeindex As Integer, spalten As Integer, zeilen As Integer, gezogen As Integer
Dim allezahlen As Integer, t As Integer, z As Integer, zaehler As Integer, zaehler1 As Integer, ziehung As Integer, RundenS As Integer
ZeilenA = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row - 1
AnzTische = ZeilenA \ 5
SpielerRaus = ZeilenA - AnzTische * 5
endeindex = ZeilenA
spalten = 4
zeilen = 2
ReDim zuzahl(ZeilenA) As String
ReDim arr1(5, AnzTische) As Variant
ReDim arr2(5, AnzTische) As Variant
ReDim zuzahl(ZeilenA) As String
ReDim zahl(ZeilenA) As String
ReDim ArrIndex(AnzTische) As Integer
Cells(1, 1) = "NamensListe"
Cells(1, 2) = "AnzahlRunden"
Cells(1, 3) = "RausFall"
RundenS = Cells(2, 2) - 2
For zaehler = 1 To UBound(ArrIndex())
ArrIndex(zaehler) = zaehler
Cells(1, zaehler + 3) = "1 Runde " & "Tisch " & zaehler
Next zaehler
For allezahlen = 2 To ZeilenA + 1
zuzahl(allezahlen - 1) = Cells(allezahlen, 1)
Next allezahlen
For ziehung = 1 To AnzTische * 5
gezogen = Int(Rnd * endeindex) + 1
zahl(ziehung) = zuzahl(gezogen)
zuzahl(gezogen) = zuzahl(endeindex)
endeindex = endeindex - 1
ReDim Preserve zuzahl(endeindex)
Cells(zeilen, spalten) = zahl(ziehung)
If spalten = 3 + AnzTische Then
zeilen = zeilen + 1
spalten = 4
Else
spalten = spalten + 1
End If
Next ziehung
arr1() = Range(Cells(2, 4), Cells(6, 3 + AnzTische))
arr2() = Range(Cells(2, 4), Cells(6, 3 + AnzTische))
For z = 0 To RundenS
For t = 1 To 5
For zaehler1 = 2 To UBound(ArrIndex())
ArrIndex(zaehler1) = ArrIndex(zaehler1)
If ArrIndex(zaehler1) > AnzTische Then ArrIndex(zaehler1) = 1
arr2(t, ArrIndex(zaehler1)) = arr1(t, zaehler1 - 1)
Next zaehler1
arr2(t, ArrIndex(1)) = arr1(t, UBound(ArrIndex()))
Next t
Range(Cells(z * 7 + 9, 4), Cells(z * 7 + 13, 3 + AnzTische)) = arr2()
arr1() = Range(Cells(z * 7 + 9, 4), Cells(z * 7 + 13, 3 + AnzTische))
arr2() = Range(Cells(z * 7 + 9, 4), Cells(z * 7 + 13, 3 + AnzTische))
For zaehler = 1 To UBound(ArrIndex())
ArrIndex(zaehler) = zaehler
Cells(z * 7 + 8, zaehler + 3) = z + 2 & " Runde " & "Tisch " & zaehler
Next zaehler
Next z
If SpielerRaus > 0 Then
For zaehler = 1 To UBound(zuzahl())
Cells(zaehler + 1, 3) = zuzahl(zaehler)
Next zaehler
End If
End Sub

Answer 5

hi all ^^
nun ist schon mal eine recht interessante problematik gestellt und trotzdem keine mitstreiter fuer inspiration und motivation :-(
ihr seid ja schlaff
1)hab ich die mathematiker vermisst
2)hab ich formelfreaks vermisst
3)hab ich vb begeisterten vermisst

das thema wird fortgesetzt da tische wie anzahl der spieler an den tischen und gesamtspieler flexibel sein sollte :-)

gruss nighty :-)

Hey,
will hoffen, das schlaff war nicht zu ernst gemeint. ;-))

Ja, das Problem ist mathematisch tatsächlich interessant.
Sogar so interessant, dass es für mich als Nichtmathematiker nicht en passant machbar ist.
D.h. gib mir Zeit und ich könnte mal schauen ...

Fand deine Lösung in AW 14 eigentlich besser, bis auf die eine Reihe die sich wiederholt hat.
Bei letzem Vorschlag vertauschst du ja bloß die Tische, aber nicht die Leute an den Tischen.

Also frohes Lösung suchen über Ostern,
Mal schauen, was ich finde...

Gruß
[list] Primut[/list]

Answer 6

hi primut ^^

ups stimmt,das darf so nicht sein

ich tuefftel noch bisl :-)

viel spass noch

gruss nighty

Answer 7

Hallo zusammen,

ich muss sagen ich bin begeistert.
Super Leute das ihr euch so engagiert meine Problemstellung zu loesen!

Vielen vielen Dank, ohne Euch wuerde ich immer noch per Hand und Zettelchen hantieren!

Weiter so!

Gruesse,
markchili

Answer 8

Leider klappts noch nicht perfekt.

Letzter Stand war der folgenden: (by nighty)

Eingaben:
A2 - A26 Namen
B2 Anzahl der Spielrunden

Macro:
Option Explicit
Sub SpielerRunde()
Range(Cells(1, 3), Cells(ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row, ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Column)) = ""
Randomize Timer
Dim ZeilenA As Long
Dim AnzTische As Integer, SpielerRaus As Integer, endeindex As Integer, spalten As Integer, zeilen As Integer, gezogen As Integer
Dim allezahlen As Integer, t As Integer, z As Integer, zaehler As Integer, zaehler1 As Integer, ziehung As Integer, RundenS As Integer
ZeilenA = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row - 1
AnzTische = ZeilenA \ 5
SpielerRaus = ZeilenA - AnzTische * 5
endeindex = ZeilenA
spalten = 4
zeilen = 2
ReDim zuzahl(ZeilenA) As String
ReDim arr1(5, AnzTische) As Variant
ReDim arr2(5, AnzTische) As Variant
ReDim zuzahl(ZeilenA) As String
ReDim zahl(ZeilenA) As String
ReDim ArrIndex(AnzTische) As Integer
Cells(1, 1) = "NamensListe"
Cells(1, 2) = "AnzahlRunden"
Cells(1, 3) = "RausFall"
RundenS = Cells(2, 2) - 2
For zaehler = 1 To UBound(ArrIndex())
ArrIndex(zaehler) = zaehler
Cells(1, zaehler + 3) = "1 Runde " & "Tisch " & zaehler
Next zaehler
For allezahlen = 2 To ZeilenA + 1
zuzahl(allezahlen - 1) = Cells(allezahlen, 1)
Next allezahlen
For ziehung = 1 To AnzTische * 5
gezogen = Int(Rnd * endeindex) + 1
zahl(ziehung) = zuzahl(gezogen)
zuzahl(gezogen) = zuzahl(endeindex)
endeindex = endeindex - 1
ReDim Preserve zuzahl(endeindex)
Cells(zeilen, spalten) = zahl(ziehung)
If spalten = 3 + AnzTische Then
zeilen = zeilen + 1
spalten = 4
Else
spalten = spalten + 1
End If
Next ziehung
arr1() = Range(Cells(2, 4), Cells(6, 3 + AnzTische))
arr2() = Range(Cells(2, 4), Cells(6, 3 + AnzTische))
For z = 0 To RundenS
For t = 1 To 5
For zaehler1 = 2 To UBound(ArrIndex())
ArrIndex(zaehler1) = ArrIndex(zaehler1)
If ArrIndex(zaehler1) > AnzTische Then ArrIndex(zaehler1) = 1
arr2(t, ArrIndex(zaehler1)) = arr1(t, zaehler1 - 1)
Next zaehler1
arr2(t, ArrIndex(1)) = arr1(t, UBound(ArrIndex()))
Next t
Range(Cells(z * 7 + 9, 4), Cells(z * 7 + 13, 3 + AnzTische)) = arr2()
arr1() = Range(Cells(z * 7 + 9, 4), Cells(z * 7 + 13, 3 + AnzTische))
arr2() = Range(Cells(z * 7 + 9, 4), Cells(z * 7 + 13, 3 + AnzTische))
For zaehler = 1 To UBound(ArrIndex())
ArrIndex(zaehler) = zaehler
Cells(z * 7 + 8, zaehler + 3) = z + 2 & " Runde " & "Tisch " & zaehler
Next zaehler
Next z
If SpielerRaus > 0 Then
For zaehler = 1 To UBound(zuzahl())
Cells(zaehler + 1, 3) = zuzahl(zaehler)
Next zaehler
End If
End Sub


Leider haben wir damit jeden Teilnehmer nur einmal pro Tisch, allerdings sind die Personen immer in 3er Pärchen zusammen unterwegs, d.h. nicht durchmischt.

Hat jemand noch eine kreative Idee was zu tun?

Grüße,
markchili

Answer 9

Hi markchili...

hab mich auch mal mit der Aufgabenstellung beschäftigt.

Eigentlich ist das sowas wie ein Sudoku.. :-)
Meine Lösung ist nur durch verschieben und tauschen entstanden:


Runde 1

Tisch 1 - 1 7 13 19 5
Tisch 2 - 6 12 18 24 10
Tisch 3 - 11 17 23 4 15
Tisch 4 - 16 22 3 9 20
Tisch 5 - 21 2 8 14 25


Runde 2

Tisch 1 - 2 8 9 10 6
Tisch 2 - 7 13 14 15 11
Tisch 3 - 12 18 19 20 16
Tisch 4 - 17 23 24 25 21
Tisch 5 - 22 3 4 5 1


Runde 3

Tisch 1 - 3 14 15 11 12
Tisch 2 - 8 19 20 16 17
Tisch 3 - 13 24 25 21 22
Tisch 4 - 18 4 5 1 2
Tisch 5 - 23 9 10 6 7


Runde 4

Tisch 1 - 4 20 16 17 18
Tisch 2 - 9 25 21 22 23
Tisch 3 - 14 5 1 2 3
Tisch 4 - 19 10 6 7 8
Tisch 5 - 24 15 11 12 13

Runde 5

Tisch 1 - 25 21 22 23 24
Tisch 2 - 5 1 2 3 4
Tisch 3 - 10 6 7 8 9
Tisch 4 - 15 11 12 13 14
Tisch 5 - 20 16 17 18 19

Wenn man die 5ver-Blöcke senkrecht untereinander oder auch waagerecht nebeneinander packt, so kommt bei der Summe der 25 Felder immer 325 raus.
Es kommt also senkrecht untereinander in jeder der 5 Spalten jede Zahl nur einmal vor.
Waagerecht nebeneinander ist die Summe pro Zeile auch immer 325.... eben das Sudoku-Prinzip.

Einen VBA-Code, der das erzeugt, kann ich leider nicht bieten..... (noch nicht.. :-) )

Hoffe es hilft Dir....

Gruß
Kauz

Answer 10

Hallo Kauz,

sieht wirklich nach einer guten Lösung aus.
Alle Achtung, das ich damit auch noch Sudoku Fans glücklich mache haette ich gar nicht gedacht.

Leider soll die Lösung auch für mehrere Tische oder Spielrunden flexibel sein.
Insofern wird man um Basic fast nicht umhin kommen.

Aber trotzdem schonmal vielen Dank, zumindest einen Teil habe ich somit wohl schonmal.

Grüße,
markchili