0

行内の異なる列の値をランダム化する方法はありますか? 以下に例を示します。

オプション 1 オプション 2 オプション 3 オプション 4

グロリア・スチュアート クレア・デーンズ キム・ベイシンガー ケイト・ウィンスレット

カーソン・デイリー クリス・ロック マシュー・ペリー デヴィッド・アークエット

モヒカン ハゲ ボラ バズ カット

ビッグ・ダディ・リトル・ニッキー・ザ・ウォーターボーイ・ハッピー・ギルモア

バージニア イタリア イギリス ドイツ

4 つの列があります。現在、オプション 4 の入力はすべて、質問に対する正解です。すべての質問で答えが常に D になるのではなく、答えが A、B、C、または D になるように、それらを行内でランダム化またはシャッフルしたいと考えています。10,000 を超える質問があるので、個別に変更するには途方もなく時間がかかります。何か助けはありますか？何も見つかりません！

4

1 に答える 1

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

スナップショット

ここに画像の説明を入力

于 2012-05-18T12:39:20.930 に答える