在Excel中，如何确保命名范围中的N个随机选择的列在每行中具有唯一值？

Question

背景

我可以从一个工作表（“Sheet2”）中的命名字符串范围中随机选择值，并在一个单独的工作表中填充一个名为MyColumn的列（“Sheet1” “）使用=INDEX(aNamedRange,RANDBETWEEN(1,ROWS(aNamedRange)))。

它看起来像这样：

|            MyColumn           |
|-------------------------------|
| RandomlySelectedValue_1, Col1 |
| RandomlySelectedValue_2, Col1 |
|              ...              |
| RandomlySelectedValue_N, Col1 |

我已经创建了另外两列：MyColumn2和MyColumn3。

问题

在RandBetween执行刷新后，有一种方法可以确保RandomlySelectedValue_1, Col1不等于RandomlySelectedValue_1, Col2?。

换句话说：

• 这是expected behavior，因为列中所有随机选择的字符串在同一行中是不同的。
• 这是what's happening，没有检查以防止同一行中任意随机选择的重复项。

我尝试了什么

我制作了这个VBA脚本：

Sub UniqueRandoms()
Do
    Worksheets("Sheet1").Range("AB7").Value = WorksheetFunction.Index(Range("FileName.xls!aNamedRange"), WorksheetFunction.RandBetween(1, Sheets("Sheet2").Rows(Range("FileName.xls!aNamedRange"))))
    Worksheets("Sheet1").Range("AC7").Value = WorksheetFunction.Index(Range("FileName.xls!aNamedRange"), WorksheetFunction.RandBetween(1, Sheets("Sheet2").Rows(Range("FileName.xls!aNamedRange"))))
    Worksheets("Sheet1").Range("AD7").Value = WorksheetFunction.Index(Range("FileName.xls!aNamedRange"), WorksheetFunction.RandBetween(1, Sheets("Sheet2").Rows(Range("FileName.xls!aNamedRange"))))
Exit Do

Loop Until Worksheets("Sheet1").Range("AB7").Value <> Worksheets("Sheet1").Range("AC7").Value And Worksheets("Sheet1").Range("AD7").Value <> Worksheets("Sheet1").Range("AC7").Value And Worksheets("Sheet1").Range("AB7").Value <> Worksheets("Sheet1").Range("AD7").Value

End Sub

但我收到了Run-time error '1004': Application-defined or object-defined error。

上述脚本是解决问题的最佳方法吗？还是有一个更简单的解决方案（可以推广到任意数量的列）？

Answer 1

我开始创造类似的东西。我将文件设置为：

我能够在A1:A7中取值并随机将它们放在顶部的列中，但没有重复。

我使用了collection，因为添加/删除项目的功能使我更容易确保我没有加倍。将值输出到工作表后，我将其从集合中删除。

Sub RandomPlay()
    Dim inputRange As Range
    Set inputRange = Sheet1.Range("A1:A7")

    Dim inputCollection As Collection
    Set inputCollection = New Collection

    'populate collection with values from the input range
    Dim rng As Range
    For Each rng In inputRange
        inputCollection.Add rng.Value
    Next rng

    Dim randomPick As Integer
    Dim i As Integer

    Dim result As Variant
    ReDim result(1 To inputCollection.Count)

    'pick randomly from collection > add to result array > remove from collection > repeat
    For i = 1 To inputCollection.Count
        randomPick = Int(Rnd() * inputCollection.Count) + 1
        result(i) = inputCollection(randomPick)
        inputCollection.Remove randomPick
    Next i

    Sheet1.Range("C2:I2").Value = result

    Set inputCollection = Nothing
End Sub

我不确定此数据设置是否与您的数据设置完全相同，但此处显示的方法无论如何都应该有用。