Randomize Columns

问题:

Is there a way to randomize the values from different columns within a row? Here is an example:

Option 1 Option 2 Option 3 Option 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

Virginia Italy England Germany

There are 4 columns. Currently all of the inputs under Option 4 are the correct answer to a question. I want to randomize or shuffle them within their row so that the answer can be A, B, C, or D instead of the answer always being D for every question. I have over 10,000 questions so individually changing them would be ridiculously time consuming. Any help? I can't find anything!

回答1:

USING 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

SNAPSHOT