随机化列

Question

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

选项1个选项2方案3方案4

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

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

莫霍克光头乌鱼巴兹剪切

大爸爸小尼基Waterboy快乐吉尔摩

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

有4列。目前，选项4下的所有输入都是对问题的正确答案。我想在他们的行内随机化或混洗它们，以便答案可以是A，B，C或D，而不是每个问题的答案都是D.我有超过10,000个问题，因此单独更改它们会非常耗时。任何帮助？我找不到任何东西！

Answer 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 

快照