0

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

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

格洛丽亚斯图尔特克莱尔丹尼斯金贝辛格凯特温斯莱特

卡森戴利克里斯洛克马修佩里大卫阿奎特

莫霍克秃头鲻鱼 Buzz Cut

Big Daddy Little Nicky The Waterboy 快乐吉尔摩

弗吉尼亚 意大利 英国 德国

有4列。目前，选项 4 下的所有输入都是问题的正确答案。我想将它们随机化或随机排列，以便答案可以是 A、B、C 或 D，而不是每个问题的答案总是 D。我有超过 10,000 个问题，因此单独更改它们会非常耗时。有什么帮助吗？我什么也找不到！

4

1 回答 1

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

快照

在此处输入图像描述

于 2012-05-18T12:39:20.930 回答