随机化列

时间:2012-05-18 11:12:58

标签: excel random shuffle

有没有办法随机化一行中不同列的值?这是一个例子:

选项1选项2选项3选项4

Gloria Stuart Claire Danes Kim Basinger Kate Winslet

Carson Daly Chris Rock Matthew Perry David Arquette

Mohawk Bald Mullet Buzz Cut

Big Daddy Little Nicky The Waterboy Happy Gilmore

弗吉尼亚意大利英格兰德国

有4列。目前,选项4下的所有输入都是问题的正确答案。我想在他们的行中随机化或随机播放它们,以便答案可以是A,B,C或D,而不是每个问题的答案总是为D.我有超过10,000个问题,所以单独更改它们将是非常耗费时间的。有帮助吗?我找不到任何东西!

1 个答案:

答案 0 :(得分:1)

使用VBA

Option Explicit

Sub Sample()
    Dim ws As Worksheet
    Dim lRow As Long, i As Long
    Dim ar As Variant
    Dim varrRandomNumberList As Variant

    Set ws = Sheets("Sheet1")

    With ws
        lRow = .Range("A" & Rows.Count).End(xlUp).Row

        For i = 2 To lRow
            ar = .Range("A" & i & ":D" & i)

            varrRandomNumberList = UniqueRandomNumbers(4, 1, 4)

            .Range("A" & i).Value = ar(1, varrRandomNumberList(1))
            .Range("B" & i).Value = ar(1, varrRandomNumberList(2))
            .Range("C" & i).Value = ar(1, varrRandomNumberList(3))
            .Range("D" & i).Value = ar(1, varrRandomNumberList(4))
        Next i
    End With
End Sub

'~~> Function picked from
'~~> http://www.exceltip.com/st/Return_random_numbers_using_VBA_in_Microsoft_Excel/531.html
Function UniqueRandomNumbers(NumCount As Long, LLimit As Long, ULimit As Long) As Variant
    '~~> Creates an array with NumCount unique long random numbers in the range
    '~~> LLimit - ULimit (including)
    Dim RandColl As Collection, i As Long, varTemp() As Long
    UniqueRandomNumbers = False
    If NumCount < 1 Then Exit Function
    If LLimit > ULimit Then Exit Function
    If NumCount > (ULimit - LLimit + 1) Then Exit Function
    Set RandColl = New Collection
    Randomize
    Do
        On Error Resume Next
        i = CLng(Rnd * (ULimit - LLimit) + LLimit)
        RandColl.Add i, CStr(i)
        On Error GoTo 0
    Loop Until RandColl.Count = NumCount
    ReDim varTemp(1 To NumCount)
    For i = 1 To NumCount
        varTemp(i) = RandColl(i)
    Next i
    Set RandColl = Nothing
    UniqueRandomNumbers = varTemp
    Erase varTemp
End Function

<强>快照

enter image description here