Yates Shuffle Excell-VBA

Question

我在Excel VBA中創建了所謂的'Yates Shuffle'，但是我被卡住了。

工作原理：
當你有一組列（我有25列的工作），你需要採取的第一列一路左側，並與在隨機列將其交換您選擇的列的右側。一旦你這樣做了，你釘住列，然後轉到右側的列（第二列）。將它與右側的隨機列交換，等等，直到您交換了所有列。

我有什麼：
到目前爲止，我已經取得了列和我有隨機準備好了，但我無法弄清楚如何將隨機連接到列（這樣會隨機隨機列而不是獲得該列的隨機數）。交換列是最大的問題。

我的代碼：

Sub Fischer() 

Dim blok As Range 

Set blok = Range("A1:Y25") 

blok.Interior.Color = vbWhite 

Dim i As Integer 

For i = 1 To 25 

    Range(Cells(1, i), Cells(i, i)).Interior.Color = vbgrey 

Next 

'Dim keuzeruimte As Range 

'Set keuzeruimte = Range(Cells(1, i + 1), Cells(i + 1, i + 1)) 

Dim j As Integer 

Dim Col2 As Range 

Dim Col1 As Range 

Dim Temp As Range 

For i = 1 To 24 

    Set Col1 = Range(Cells(1, i), Cells(i, i)) 

    j = Int(25 - (i + 1)) * Rnd + (i + 1) 

    MsgBox (j) 

    Set Col2 = Range(Cells(1, j), Cells(j, j)) 

    Set Temp = Col1 

    Col1 = Col2 

    Col2 = Temp 

    Next 

End Sub 

Answer 1

你的代碼是做什麼你告訴它做的事。但是這與你所描述的略有不同。如果你想交換整列數據的內容，那麼你需要一個小的調整。 （這會使你的代碼更加明顯，除了改變格式顏色之外，如果你使用值填充單元格的話。）

你必須找到你的交換列（Temp）在一個特定的位置來使用它你想要的方式。所以，只交換值，你的循環應該閱讀：

Option Explicit 

Sub Fischer() 
    Dim blok As Range 
    Set blok = Range("A1:Y25") 
    blok.Interior.Color = vbWhite 

    Dim i As Integer 
    For i = 1 To 25 
     Range(Cells(1, i), Cells(i, i)).Interior.Color = vbRed 
    Next 

    Dim j As Integer 
    Dim Col2 As Range 
    Dim Col1 As Range 
    Dim Temp As Range 
    Set Temp = Range(Cells(1, 27), Cells(25, 27)) 

    For i = 1 To 24 
     Set Col1 = Range(Cells(1, i), Cells(25, i)) 
     j = Int(25 - (i + 1)) * Rnd + (i + 1) 
     Debug.Print j 
     Set Col2 = Range(Cells(1, j), Cells(25, j)) 
     Temp.Value = Col1.Value 
     Col1.Value = Col2.Value 
     Col2.Value = Temp.Value 
    Next 
End Sub 

如果交換格式是你真正想要的，那麼你還是要錨你Temp列在其他地方，但它現在是一個副本，麪食方法：

Option Explicit 

Sub Fischer2() 
    Dim blok As Range 
    Set blok = Range("A1:Y25") 
    blok.Interior.Color = vbWhite 

    Dim i As Integer 
    For i = 1 To 25 
     Range(Cells(1, i), Cells(i, i)).Interior.Color = vbRed 
    Next 

    Dim j As Integer 
    Dim Col2 As Range 
    Dim Col1 As Range 
    Dim Temp As Range 
    Set Temp = Range(Cells(1, 27), Cells(25, 27)) 

    For i = 1 To 24 
     Set Col1 = Range(Cells(1, i), Cells(25, i)) 
     j = Int(25 - (i + 1)) * Rnd + (i + 1) 
     Debug.Print j 
     Set Col2 = Range(Cells(1, j), Cells(25, j)) 
     Col1.Copy 
     Temp.PasteSpecial xlPasteAllUsingSourceTheme 
     Col2.Copy 
     Col1.PasteSpecial xlPasteAllUsingSourceTheme 
     Temp.Copy 
     Col2.PasteSpecial xlPasteAllUsingSourceTheme 
    Next 
End Sub