プロが教えるわが家の防犯対策術!

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

A 回答 (3件)

おもしろそうですね。


Rnd関数にDictionaryオブジェクトを組み合わせてみました。
これなら3択じゃなくとも、5択でも10択?でも楽に行けます。

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
    • good
    • 0
この回答へのお礼

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

お礼日時:2010/12/10 09:59

試してみてください。



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")を作業用に使っています。
    • good
    • 0
この回答へのお礼

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

お礼日時:2010/12/10 13:31

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



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つとかだと、こんなマクロを組む気にはなれません(笑)
    • good
    • 0
この回答へのお礼

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

お礼日時:2010/12/10 09:55

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!