Вопрос по excel, random – Рандомизировать столбцы

0

Есть ли способ рандомизировать значения из разных столбцов в строке? Вот пример:

Вариант 1 Вариант 2 Вариант 3 Вариант 4

Глория Стюарт Клэр Дейнс Ким Бейсингер Кейт Уинслет

Карсон Дейли Крис Рок Мэтью Перри Дэвид Аркетт

Mohawk Лысый кефаль Buzz Cut

Большой папочка Литтл Никки Уотербой С Днем Гилмора

Virginia Италия Англия Германия

Есть 4 столбца. В настоящее время все входные данные в Варианте 4 являются правильным ответом на вопрос. Я хочу рандомизировать или перемешать их в их ряду, чтобы ответ мог быть A, B, C или D вместо ответа всегда D для каждого вопроса. У меня более 10000 вопросов, поэтому индивидуальное их изменение было бы смехотворно трудоемким. Любая помощь? Я ничего не могу найти!

use RANDBETWEEN, чтобы сгенерировать смещение столбца, а затем создать ссылку на один из 4 столбцов, а результат RANDBETWEEN будет передан в функцию OFFSET. Boud

Ваш Ответ

1   ответ
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

enter image description here

Похожие вопросы