Hallo
@Carsten und Conny,
ich glaube Christian hat recht.
a)Wenn ich die Liste erst nach Klasse und dann nach Fach ordne, ist der 16. Schüler zwar aus einer anderen Klasse als der 1.Schüler, kann aber das gleiche Fach haben.
b)Wenn ich die Liste erst nach Fach und dann nach Klasse ordne, hat der 16. Schüler zwar ein anderes Fach als der 1.Schüler, kann aber aus der gleichen Klasse sein.
@Christian
In der Anlage einmal eine programmierte Lösung.
Bemerkungen:
a) Vorraussetzungen
Da ich in Programmen nicht gerne mit festen Adressen arbeite benötigt das Programm zur Zeit zwei benannte Bereiche:
1) einen
benannten Bereich "Liste"
Die Anzahl der Zeilen in diesem Bereich entspricht der Anzahl der Plätze = Anzahl der Tische * 2
Der Bereich umfasst mindestens 5 Spalten
1. Spalte eine Kennung des Schülers (zB laufende Nummer in dieser Liste)
2. Spalte Werte bis zur Anzahl der Schüler (von oben ohne Lücken). Aus dieser Spalte ermittelt das Programm die Anzahl der Schüler.
4. Spalte Klasse oder Fach
5. Spalte Klasse oder Fach
2) eine
benannte Zelle "Ausgabe"
Unter dieser Zelle werden die Kennungen des Schülers ausgegeben. Jeweils zwei Plätze (von oben) gehören zu einem Tisch.
Die Zelle "Ausgabe" kann beliebig in der Datei positioniert werden (auch in ein anderes Arbeitsblatt) ohne das Programm anpassen zu müssen.
b) Zufallszahlen
Da die Positionen über Zufallszahlen ermittelt werden, müssen die Versuche eine gültige Lösung zu finden begrenzt werden. Es kann sein, dass das Programm mit den eingetragenen Grenzen keine gültige Lösung findet, obwohl es eine gibt.
Bei einem wiederholten Aufruf kann dann doch eine Lösung gefunden werden.
Ich weis nicht wie schnell dein Rechner ist, daher habe ich die die Grenze der Versuche relativ klein gemacht. Falls das Programm einmal keine Lösung findet und die entsprechende Meldung schnell ausgibt, könntest du im Programm die Konstante "intAnzVersuche" auch erhöhen, um nicht zu häufig manuell die Zuordnung neu anzustossen.
Code:
Option Explicit
Private Sub cbTuwat_Click()
Dim intPos As Integer
Dim intAnzPlaetze As Integer
Dim intAnzTische As Integer
Dim intAktTisch As Integer
Dim intAnzSchueler As Integer
Dim intAktSchueler As Integer
Dim intAktVersuch As Integer
Dim intAktTest As Integer
Dim varListe As Variant
Dim varPlaetze As Variant
Dim rngAusgabe As Range
Dim bolGefunden As Boolean
Dim collSchueler As Collection
Dim collTische As Collection
Const intAnzVersuche As Integer = 100
Const intAnzTests As Integer = 10
Dim dblStart As Double
dblStart = Timer
varListe = ThisWorkbook.Names("Liste").RefersToRange.Value
Set rngAusgabe = ThisWorkbook.Names("Ausgabe").RefersToRange
intAnzPlaetze = UBound(varListe, 1)
intAnzTische = intAnzPlaetze / 2
bolGefunden = True
intAnzSchueler = 1
While intAnzSchueler <= intAnzPlaetze And bolGefunden
If varListe(intAnzSchueler, 2) = "" Then
bolGefunden = False
Else
intAnzSchueler = intAnzSchueler + 1
End If
Wend
intAnzSchueler = intAnzSchueler - 1
If intAnzSchueler < intAnzTische Then
intAnzTische = intAnzSchueler
End If
Randomize
bolGefunden = False
intAktVersuch = 0
While Not bolGefunden And intAktVersuch < intAnzVersuche
intAktVersuch = intAktVersuch + 1
ReDim varPlaetze(1 To intAnzPlaetze, 1 To 2)
Set collSchueler = New Collection
For intAktSchueler = 1 To intAnzSchueler
collSchueler.Add intAktSchueler
Next intAktSchueler
For intAktTisch = 1 To intAnzTische
intPos = Application.WorksheetFunction.RandBetween(1, collSchueler.Count)
varPlaetze(intAktTisch * 2 - 1, 2) = collSchueler(intPos)
varPlaetze(intAktTisch * 2 - 1, 1) = varListe(collSchueler(intPos), 1)
collSchueler.Remove (intPos)
Next intAktTisch
If collSchueler.Count > 0 Then
Set collTische = New Collection
For intAktTisch = 1 To intAnzTische
collTische.Add intAktTisch
Next intAktTisch
intAktTest = 0
intAktSchueler = 1
While intAktSchueler <= collSchueler.Count And intAktTest < intAnzTests
intPos = Application.WorksheetFunction.RandBetween(1, collTische.Count)
If varListe(collSchueler(intAktSchueler), 4) <> varListe(varPlaetze(collTische(intPos) * 2 - 1, 2), 4) _
And varListe(collSchueler(intAktSchueler), 5) <> varListe(varPlaetze(collTische(intPos) * 2 - 1, 2), 5) Then
varPlaetze(collTische(intPos) * 2, 2) = collSchueler(intAktSchueler)
varPlaetze(collTische(intPos) * 2, 1) = varListe(collSchueler(intAktSchueler), 1)
collTische.Remove (intPos)
intAktSchueler = intAktSchueler + 1
Else
intAktTest = intAktTest + 1
End If
Wend
If intAktTest < intAnzTests Then
bolGefunden = True
End If
Else
bolGefunden = True
End If
Wend
If bolGefunden Then
rngAusgabe.Resize(intAnzPlaetze, 1) = varPlaetze
Else
rngAusgabe.Resize(intAnzPlaetze, 1).ClearContents
MsgBox "keine passende Zuordnung gefunden." & " " & Timer - dblStart
End If
End Sub