Вопрос по excel, random – Рандомизировать столбцы
Есть ли способ рандомизировать значения из разных столбцов в строке? Вот пример:
Вариант 1 Вариант 2 Вариант 3 Вариант 4
Глория Стюарт Клэр Дейнс Ким Бейсингер Кейт Уинслет
Карсон Дейли Крис Рок Мэтью Перри Дэвид Аркетт
Mohawk Лысый кефаль Buzz Cut
Большой папочка Литтл Никки Уотербой С Днем Гилмора
Virginia Италия Англия Германия
Есть 4 столбца. В настоящее время все входные данные в Варианте 4 являются правильным ответом на вопрос. Я хочу рандомизировать или перемешать их в их ряду, чтобы ответ мог быть A, B, C или D вместо ответа всегда D для каждого вопроса. У меня более 10000 вопросов, поэтому индивидуальное их изменение было бы смехотворно трудоемким. Любая помощь? Я ничего не могу найти!
use RANDBETWEEN, чтобы сгенерировать смещение столбца, а затем создать ссылку на один из 4 столбцов, а результат RANDBETWEEN будет передан в функцию OFFSET.
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
Похожие вопросы
use RANDBETWEEN, чтобы сгенерировать смещение столбца, а затем создать ссылку на один из 4 столбцов, а результат RANDBETWEEN будет передан в функцию OFFSET.
