2017-03-06 17 views
1

私はExcel VBAで「Yates Shuffle」と呼ばれていますが、私は立ち往生しています。Yates Shuffle Excell-VBA

仕組み:
あなたは列のセットを(私は25列で働いている)を使用すると、左側の最初の列のすべての方法を取ると、上のランダムな列でそれを交換する必要がある場合あなたが取った列の右。いったんこれをしたら、列をピンで止め、右の列(2列目)に移動します。すべての列を交換するまで、右のランダムな列でスワップします。

私が持っているもの:
は、これまでのところ私は列を作っていると私は、ランダマイザーの準備ができていますが、私はランダマイザが列をランダム化するように、(列にランダマイザを接続する方法を見つけ出すことはできません列の乱数を得るのではなく)。カラムを交換することが最大の課題です。

マイコード:

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 

答えて

1

あなたのコードは、あなたがすることを指示しました正確に何やっています。しかし、それはあなたが記述したものとは少し異なります。データ列全体の内容を交換する場合は、小さな調整が必要です。

スワップカラム(Temp)を特定の場所に配置して使用する必要があります(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 
関連する問題