Question

我在Excel VBA中制作了一个所谓的'Yates Shuffle'，但我被卡住了。

工作原理：
如果你有一组列（我正在使用25列），你需要在左边一直占据第一列，然后用你所选列右边的随机列交换它。完成后，您将固定列，然后转到右侧的列（第二列）。用右边的随机列交换它，依此类推，直到你换掉所有列。

我有什么：
到目前为止，我已经制作了列，并且我已经准备好了随机数发生器，但是我无法弄清楚如何将随机数发生器附加到列上（因此随机化器将随机化列而不是获得列的随机数）。交换列是最大的问题。

我的代码：

successCallback(data: TemplateCollection) {
        store.templates = { skipped: 0, set: 0, total: 0, collection: [] }
        store.templates = data;
        alert(store.templates.collection.length);
    }

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

Yates Shuffle Excel-VBA

1 个答案: