エクセルのマクロの作り方で、教えてください。

質問

エクセルのVBAを使って、選択肢を選んで答える簡単な学習ソフトを作っています。問題文を作るときは正解をいちばん左のセルに入れて、あとから3つの選択肢の順番をランダムに入れ替える簡単なマクロを作ろうとしましたがうまくいきません。たとえば、A列に問題番号、B列に問題文、C列～E列までに選択肢の1，2，3が入っています。問題は20問、つまり1から20行まで入っています。そしてコマンドボタンを押すと適当にC～Eの内容が入れ替わるようにしたいのです。私がやろうとしたのは選択肢１～3を文字列の変数にして、1行目から20行目まではループで実行させるのですが、肝心な入れ替えをどのようにしたらよいかわかりません。乱数を使ったらどうかと思ったのですが、使い方がわかりません。もっと簡単な方法があればそれも教えてください。VBAの初心者ですのでよろしくお願いします。

回答No.2

merlionXX · ベストアンサー

おもしろそうですね。
Rnd関数にDictionaryオブジェクトを組み合わせてみました。
これなら３択じゃなくとも、５択でも１０択？でも楽に行けます。

Sub test01()
　　Dim myW, myX
　　Dim myDic As Object
　　Dim i As Long, x As Long, n As Long
　　myW = Range("C1:E20").Value
　　ReDim myX(1 To UBound(myW, 1), 1 To UBound(myW, 2))
　　Set myDic = CreateObject("Scripting.Dictionary")
　　For i = 1 To 20
　　　　Randomize
　　　　Do Until myDic.Count = 3
　　　　　　x = Int(Rnd() * 3) + 1
　　　　　　If Not myDic.Exists(x) Then
　　　　　　　　myDic.Add x, ""
　　　　　　End If
　　　　Loop
　　　　For n = 1 To 3
　　　　　　myX(i, myDic.keys()(n - 1)) = myW(i, n)
　　　　Next n
　　　　myDic.RemoveAll
　　Next i
　　Range("C1:E20").Value = myX
End Sub

お礼

Dictionaryの使い方を本で読んで知ってはいましたが、ここで思いつきませんでした。5択でもできるというので、早速やってみます。ありがとうございます。

回答No.3

ki-aaa

試してみてください。

Sub test_rnd()
Dim myrag As Range

Randomize

For Each myrag In Range("F2:H21")
myrag = Rnd
Next myrag

Range("C2").Formula = "=RANK(F2,$F2:$H2,0)"
Range("C2").Copy
Range("C2:E21").PasteSpecial Paste:=xlPasteAll
Application.Calculation = xlAutomatic
Range("C2:E21").Copy
Range("C2:E21").PasteSpecial Paste:=xlPasteValues
Range("F2:H21").ClearContents
End Sub

このマクロでは、セルの("F2:H21")を作業用に使っています。

お礼

回答ありがとうございました。できました。簡単にできることに感動しました。おかげで少しずつVBAのことがわかってきました。お礼申し上げます。

回答No.1

nattocurry

全然スマートじゃない力技ですが、こんなのはどうでしょう？

Sub test()
Dim r As Long
For r = 1 To 20
Dim ans1, ans2, ans3
Dim x1, x2
x1 = Rnd()
x2 = Rnd()
If x1 < 1 / 3 Then
If x2 < 1 / 2 Then
ans1 = Cells(r, "C").Value
ans2 = Cells(r, "D").Value
ans3 = Cells(r, "E").Value
Else
ans1 = Cells(r, "C").Value
ans2 = Cells(r, "E").Value
ans3 = Cells(r, "D").Value
End If
ElseIf x1 < 2 / 3 Then
If x2 < 1 / 2 Then
ans1 = Cells(r, "D").Value
ans2 = Cells(r, "C").Value
ans3 = Cells(r, "E").Value
Else
ans1 = Cells(r, "D").Value
ans2 = Cells(r, "E").Value
ans3 = Cells(r, "C").Value
End If
Else
If x2 < 1 / 2 Then
ans1 = Cells(r, "E").Value
ans2 = Cells(r, "C").Value
ans3 = Cells(r, "D").Value
Else
ans1 = Cells(r, "E").Value
ans2 = Cells(r, "D").Value
ans3 = Cells(r, "C").Value
End If
End If
Cells(r, "C").Value = ans1
Cells(r, "D").Value = ans2
Cells(r, "E").Value = ans3
Next r
End Sub

選択肢がたった3つだから何とかなりますが、選択肢が5つとかだと、こんなマクロを組む気にはなれません(笑)

お礼

回答ありがとうございました。私もこのように作ってみたのですが、もっと短くなるかなと思ったのです。私と同じような回答でうれしかったです。