随机列 [英] Randomize Columns

问题描述

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

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

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

Option 1 Option 2 Option 3 Option 4

Gloria Stuart Claire Danes Kim Basinger Kate Winslet

Gloria Stuart Claire Danes Kim Basinger Kate Winslet

Carson Daly Chris Rock Matthew Perry David Arquette

Carson Daly Chris Rock Matthew Perry David Arquette

Mohawk Bald Mullet Buzz Cut

Mohawk Bald Mullet Buzz Cut

Big Daddy Little Nicky The Waterboy Happy Gilmore

Big Daddy Little Nicky The Waterboy Happy Gilmore

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

Virginia Italy England Germany

有4列。目前，方案4下的所有投入都是对问题的正确答案。我想在他们的行中随机或洗牌，以便答案可以是A，B，C或D，而不是每个问题的答案总是D。我有超过10,000个问题，所以单独改变它们将是荒谬的耗时。任何帮助？我找不到任何东西！

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!

推荐答案

使用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

这篇关于随机列的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！