Ich habe ein Werkzeug zusammengestellt, um zufällige Zeilen- / Spalten-Permutationen mit ein paar Formeln und etwas VBA zu erstellen. Das Blattlayout sieht folgendermaßen aus:
Das Referenzraster ist ein triviales Beispiel für eine gültige Matrix, wie in der vorläufigen Antwort von Garys Student (möglicherweise seit dem gestrichen). Die Zeilen- und Spaltenpermutationen enthalten alle möglichen eindeutigen Kombinationen von Permutationen für das 6x6-Gitter. (Dies kann leicht modifiziert werden, falls gewünscht, um nicht eindeutige Permutationen zu enthalten.) Die Werte in E12:E26
und L12:L26
werden zufällig entweder auf Null oder Eins gesetzt, um die Grundlage dafür zu schaffen, ob eine bestimmte Permutation durchgeführt werden soll oder nicht. Spalten D
und K
konvertieren Sie diese einfach in boolesche Werte, um die Handhabung innerhalb der VBA zu vereinfachen (siehe unten). Das permutierte Gitter wird von der benutzerdefinierten Funktion generiert doSwap
, die als Matrixformel eingegeben wird. Durch Drücken F9
von wird die Neuberechnung des Blatts ausgelöstRAND
Funktionen zum erneuten Generieren ihrer Zufallswerte, wodurch die Reihe der durchzuführenden Permutationen geändert wird.
Der VBA-Code, der dieses Verhalten ermöglicht, lautet:
Function doSwap(srcRg As Range, rowSwaps As Range, colSwaps As Range) As Variant Dim workVt As Variant Dim iter As Long workVt = srcRg.Value ' Do row swaps For iter = 1 To rowSwaps.Rows.Count With rowSwaps If .Cells(iter, 3).Value Then workVt = swapRow(workVt, .Cells(iter, 1), .Cells(iter, 2)) End If End With Next iter ' Do col swaps For iter = 1 To colSwaps.Rows.Count With colSwaps If .Cells(iter, 3).Value Then workVt = swapCol(workVt, .Cells(iter, 1), .Cells(iter, 2)) End If End With Next iter ' Store and return doSwap = workVt End Function Function swapCol(ByVal inArr As Variant, idx1 As Long, idx2 As Long) As Variant Dim tempVal As Variant, workVt As Variant Dim iter As Long ' Check if Range or Array input If IsObject(inArr) Then If TypeOf inArr Is Range Then workVt = inArr.Value Else swapCol = "ERROR" Exit Function End If Else workVt = inArr End If ' Just crash if not correct size ' Do swap For iter = LBound(workVt, 1) To UBound(workVt, 1) tempVal = workVt(iter, idx1) workVt(iter, idx1) = workVt(iter, idx2) workVt(iter, idx2) = tempVal Next iter ' Return swapCol = workVt End Function Function swapRow(ByVal inArr As Variant, idx1 As Long, idx2 As Long) As Variant Dim tempVal As Variant, workVt As Variant Dim iter As Long ' Check if Range or Array input If IsObject(inArr) Then If TypeOf inArr Is Range Then workVt = inArr.Value Else swapRow = "ERROR" Exit Function End If Else workVt = inArr End If ' Just crash if not correct size ' Do swap For iter = LBound(workVt, 2) To UBound(workVt, 2) tempVal = workVt(idx1, iter) workVt(idx1, iter) = workVt(idx2, iter) workVt(idx2, iter) = tempVal Next iter ' Return swapRow = workVt End Function
Der obige Code ist nicht gut robust, dient jedoch dem vorliegenden Zweck. Erweiterung / Verallgemeinerung sollte bei Bedarf recht unkompliziert sein. Insbesondere sollte es jede Größe eines 2-D-Referenzgitters, auch eines, das nicht quadratisch ist, handhaben. Der Schlüssel ist, sicherzustellen, dass die Arrays der Permutationsanweisungen ordnungsgemäß eingerichtet sind.
BEARBEITEN: Nachdem Sie ein wenig damit gespielt haben, ist es klar, dass diese Lösung keinen Zugriff auf den gesamten Raum möglicher Permutationen bietet. Also habe ich es mit einem zufälligen " Bit-Shift " geändert, um die Typenbezeichnungen untereinander auszutauschen. Um die Sache zu vereinfachen, habe ich von ABC
Labels zu 123
Labels gewechselt, was die Implementierung durch eine einfache MOD
Operation und eine schnelle Überprüfung der Sanitätsprüfung in Form von Zeilen- und Spaltensummen ermöglicht: