エクセルマクロ、VBAにてあみだくじ

質問

初心者です。宜しくお願いいたします。

エクセルでくじを作りたいと思います。

エクセルのシートに、あみだくじというボタンを押すと
１～15までの数字及び、「あなたはこの数字です」というメッセージが乱数として
重ならないで出ると言うものを作りたいのです。
（15回より多くクリックできないという事もしたいと思います。）

何か良い知恵はありませんか。宜しくお願いいたします。

回答No.2

tom04 · ベストアンサー

こんばんは！
一例です。

↓の画像のようにSheet2に1～15の数値を表示させ、それを利用してSheet1のA1セルに表示させるようにしてみました。

Sheet1にコマンドボタンを挿入　→　挿入したコマンドボタン上でダブルクリック　→　VBE画面が出ますので、
↓のコードをコピー＆ペーストしてコマンドボタンをクリックしてみてください。
（Sheet2の表は作る必要はありません）

Private Sub CommandButton1_Click() 'この行から
Dim ws1, ws2 As Worksheet
Set ws1 = Worksheets("sheet1")
Set ws2 = Worksheets("sheet2")
If ws2.Range("C1") = "" Then
処理1:
ws2.Range("A1").FormulaR1C1 = "=rand()"
ws2.Range("A1").AutoFill Destination:=ws2.Range("A1:A15")
ws2.Range("A1:A15").Copy
ws2.Range("A1").PasteSpecial xlPasteValues
ws2.Range("B1").FormulaR1C1 = "=rank(RC[-1],R1C1:R15C1)"
ws2.Range("B1").AutoFill Destination:=ws2.Range("B1:B15")
ws2.Range("C1") = ws2.Range("B1")
ws1.Range("A1") = "あなたの番号は、" & ws2.Range("C1") & "番です。"
Else
Dim i As Long
i = WorksheetFunction.Match(ws2.Range("C1"), ws2.Range("B1:B15"), False)
ws2.Range("C1") = ws2.Range("B" & i + 1)
ws1.Range("A1") = "あなたの番号は、" & ws2.Range("C1") & "番です。"
End If
If ws2.Range("C1") = ws2.Range("B15") Then
If MsgBox("これ以上クリックできません。" & vbCrLf & "「クジ」を新しくしますか？" _
, vbYesNo) = vbYes Then
GoTo 処理1
Else
Exit Sub
End If
End If
End Sub 'この行まで

こんな感じではどうでしょうか？m(__)m

お礼

細かくご指示を頂きありがとうございました。何とか形になりました。

回答No.1

kuma56

方法はこんなもん↓でいいのでは？
１．どこかのシートに１～１５までの数字を１列に入れておく。
２．ボタンを押すとマクロで上記の数字の文字数内でランダムに数字を発生させる（ランダム数）
３．発生させたランダム数に相当するセルにある数字を"あなたの数字"として表示させる。
４．表示させた数字を削除して、その分後ろの数字を詰める。
５．上記の２．に戻り繰り返す。
６．１．の数字がなくなったらマクロを起動させないようにする。
技術的にどうしたらいいかはしっかり考えてみて、判らない点はそこにポイントを絞った質問をすればいいでしょう。

お礼

早速ありがとうございました。

できれば、構文なんかを載せていただくとありがたく存じます。
すみません。初心者ですので、宜しくお願いいたします。