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

Hrm, es scheint als ob das Problem wohl wirklich nicht so einfach zu lösen wäre.
Hat denn wirklich niemand eine Idee?

Grüße,
markchili

Answer 2

hi all ^^

nicht optimiert

gruss nighty

'1 zeile ueberschrift
'spalte a-e (5) tische
'spalte g zeile 2 bis 26 namen
Option Explicit
Sub makro01()
Randomize Timer
Dim daten(25)
Dim daten1(25)
ReDim zuzahl(25) As String
Dim zahl(25) As String
Dim endeindex As Integer, spalten As Integer, zeilen As Integer
Dim allezahlen As Integer, tische As Integer, t As Integer
Dim ziehung As Integer
Dim gezogen As Integer
endeindex = 25
For allezahlen = 2 To 26
zuzahl(allezahlen - 1) = Cells(allezahlen, 7)
Next allezahlen
spalten = 1
zeilen = 2
For ziehung = 1 To 25
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)
daten(ziehung) = zahl(ziehung)
If spalten = 5 Then
zeilen = zeilen + 1
spalten = 1
Else
spalten = spalten + 1
End If
Next ziehung
For tische = 1 To 4
zeilen = zeilen + 1
For t = 1 To 24
daten1(t + 1) = daten(t)
Next t
daten1(1) = daten(25)
For t = 1 To 25
daten(t) = daten1(t)
Cells(zeilen, spalten) = daten1(t)
If spalten = 5 Then
zeilen = zeilen + 1
spalten = 1
Else
spalten = spalten + 1
End If
Next t
Next tische
End Sub

Answer 3

hi all

und getestet auch nicht,mir kreisen jetzt schon die tische im kopf herum,runde tische eckige tische hohe tische holztische
o_o

gruss nighty

Answer 4

hi all ^^

auf jedenfall interessantes thema und mit einem murkscode geb ich mich nicht zufrieden

eine zufriedenstellende loesung waere eine von tischen wie mitspieler flexible loesung :-)

dann rueckt mal raus mit euren ideen ,ich verbesser zwichenzeitlich meinen code :-
)

gruss nighty

Answer 5

Hallo Nighty,

habe mich mal an Deinem Code versucht und dabei bemerkt das hier irgendwas nicht passt:

Ich habe Namen von a bis z vergeben und die Tische 1-5 nummeriert.

Allerdings sitzen nach dem Code Ablauf immer diesselbe Leute an einem Tisch, sie wechseln sozusagen als Gruppe vom 1. -> 2. etc.

Oder ich habe Deinen Ansatz falsch verstanden ....

Die Tische sind übrigens rund ;)

Grüße,
markchili

Answer 6

Ach ja und Danke schonmal natürlich!

Answer 7

hi markchili

eigentlich sollte eine rotation stattfinden, wie eine kette ohne ende,da muss ich doch mal schauen

gruss nighty

Answer 8

Hi Nighty,

an Deine optimierung meiner Idee, mit der variablen Auswahl der Anzahl Teilnehmer und Anzahl Tische / Runden habe ich natürlich auch schon gedacht, aber für den Einstieg erscheint mir schon das Problem verzwickt genug.

Ich bin auch noch am knobeln, aber mit meinem Excel Wissen wirds da seeehr eng ...

Grüße,
markchili

Answer 9

hi all ^^

erneuerter versuch :-)

gruss nighty

@markchili
bitte testen :-))

Sub makro01()
Randomize Timer
Dim daten(25)
Dim daten1(25)
ReDim zuzahl(25) As String
Dim zahl(25) As String
Dim endeindex As Integer, spalten As Integer, zeilen As Integer
Dim allezahlen As Integer, t As Integer, z As Integer, a1 As Integer, a2 As Integer, a3 As Integer, a4 As Integer, a5 As Integer
Dim ziehung As Integer
Dim gezogen As Integer
endeindex = 25
For allezahlen = 2 To 26
zuzahl(allezahlen - 1) = Cells(allezahlen, 7)
Next allezahlen
spalten = 1
zeilen = 2
For ziehung = 1 To 25
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)
daten(ziehung) = zahl(ziehung)
If spalten = 5 Then
zeilen = zeilen + 1
spalten = 1
Else
spalten = spalten + 1
End If
Next ziehung
Rem
ReDim arr1(5, 5) As Variant
ReDim arr2(5, 5) As Variant
arr1() = Range("A2:E6")
arr2() = Range("A2:E6")
a1 = 1
a2 = 3
a3 = 5
a4 = 2
a5 = 4
For z = 1 To 4
For t = 1 To 5
If a1 > 5 Then a1 = 1
If a2 > 5 Then a2 = 1
If a3 > 5 Then a3 = 1
If a4 > 5 Then a4 = 1
If a5 > 5 Then a5 = 1
arr2(t, 2) = arr1(t, a1)
arr2(t, 4) = arr1(t, a2)
arr2(t, 1) = arr1(t, a3)
arr2(t, 3) = arr1(t, a4)
arr2(t, 5) = arr1(t, a5)
arr1(t, a1) = arr2(t, 2)
arr1(t, a2) = arr2(t, 3)
arr1(t, a3) = arr2(t, 1)
arr1(t, a4) = arr2(t, 3)
arr1(t, a5) = arr2(t, 5)
a1 = a1 + 1
a2 = a2 + 1
a3 = a3 + 1
a4 = a4 + 1
a5 = a5 + 1
Next t
Range("A" & z * 6 & ":E" & z * 6 + 4) = arr2()
arr1() = Range("A" & z * 6 & ":E" & z * 6 + 4)
arr2() = Range("A" & z * 6 & ":E" & z * 6 + 4)
Next z
End Sub

Answer 10

Hi nighty,

alle Namen stehen in Spalte G1-26, sonst brauche ich nichts weiter angeben, oder?
Mir fällt auf das nach der ersten Runde keine Leerzeile ist, und somit der erste Absatz (Runde 1+2) zusammenhängt. Zusätzlich komisch ist auch das er nur 9 Teilnehmer hat?!?!

Oder ich habs verpeilt.

Grüße,
markchili