マンゴー杯！
こんにちは。
派犬事務員のコロ子です。
マンゴー杯 結果報告
前回、あみだくじや抽選のコードを「自分ならこう書く！」を募集したところ、素晴らしいアイディアの応募がありました！どうもありがとうございます！！
みんな演出が凝っていて高度な技が満載！
エントリーNo.１
セラエノ (id:celaeno42)さん
celaeno42.hatenablog.com
エントリーNo.２
id:Infomentさん
infoment.hatenablog.com
さらに進化版。あみだくじの格子部分もマクロで作る↓
infoment.hatenablog.com
すごい！！！
あみだくじの完成形。必見↓
infoment.hatenablog.com
あみだくじファイナル↓
infoment.hatenablog.com
エントリーNo.3
Kou (id:ExcelLover)さん
www.excellovers.com
エントリーNo.4
コロ子
ちょっとみんな凄すぎて実力の差がありすぎる・・・。
こうなったらコロ子が絶対当たるマクロを作ろう。
【コロ子が絶対当たる抽選】
マンゴーの数を入力して「抽選」ボタンを押すと、「当たり」「はずれ」が表示される。コロ子は絶対「当たり」が出る。
【考え方】
①「当たり・はずれの要素」「乱数を入れる要素」を加者数-1（コロ子を抜かす）の要素数の2次元配列を用意する。
②「当たり・はずれの要素」の先頭から、マンゴーの数-1個の当たり、後ははずれを入れる。
③「乱数を入れる要素」に整数1～参加者数を重複しないでランダムに入れる。
例：マンゴーの数3個、コロ子以外の参加者7人の場合の配列のイメージ
④「乱数を入れる要素」で昇順にソートする。
⑤結果セルに「乱数を入れる要素」を順に入れていく。
このとき参加者が「コロ子」だったら当たりを入れスキップし、次のセルへ。
【コード】
抽選ボタン
Sub Absolutely_win()
Dim i As Long, j As Long
Dim StartCell As Long
Dim Cellcount As Long
Dim Arr() As Variant
Application.ScreenUpdating = False
StartCell = 5
Cellcount = Cells(Rows.Count, 1).End(xlUp).Row - StartCell
ReDim Arr(1 To Cellcount, 1)
For i = 1 To Cellcount
If i < Range("B2").Value Then
Arr(i, 0) = "当たり"
Else
Arr(i, 0) = "はずれ"
End If
Dim Flg() As Boolean
ReDim Flg(1 To Cellcount)
Dim Num As Long
'整数1～参加者数を重複しないでランダムに発生させる
Randomize
Do
Num = Int((Cellcount - 1 + 1) * Rnd + 1)
Loop Until Flg(Num) = False
Arr(i, 1) = Num
Flg(Num) = True
Next i
'ソート
Call ArrSort(Arr)
'セルに配列を入れる（コロ子の時は当たりを入れる）
For i = 1 To Cellcount
Cells(StartCell, 2).Value = Arr(i, 0)
If Cells(StartCell, 1).Value = "コロ子" Then
Cells(StartCell, 2).Value = "当たり"
i = i - 1
End If
StartCell = StartCell + 1
Next i
Application.ScreenUpdating = True
End Sub※範囲を指定して乱数を発生させる
乱数=Int((最大値 - 最小値 +1 ) * Rnd + 最小値)
配列をソートする
Sub ArrSort(Arr As Variant)
Dim bufL As Long
Dim bufS As String
Dim i As Double
Dim j As Double
For i = UBound(Arr, 1) To LBound(Arr, 1) Step -1
For j = LBound(Arr, 1) To i - 1
If Arr(j, 1) > Arr(j + 1, 1) Then
bufS = Arr(j, 0)
bufL = Arr(j, 1)
Arr(j, 0) = Arr(j + 1, 0)
Arr(j, 1) = Arr(j + 1, 1)
Arr(j + 1, 0) = bufS
Arr(j + 1, 1) = bufL
End If
Next j
Next iやったー！コロ子マンゴー当たったー！！
セコイ！！
こーゆー不正はダメですよ！
【今回のポイント】
整数1～参加者数を重複しないでランダムに発生させる
For i = 1 To Cellcount
・
・
・
Dim Flg() As Boolean
ReDim Flg(1 To Cellcount)
Dim Num As Long
Randomize
Do
Num = Int((Cellcount - 1 + 1) * Rnd + 1)
Loop Until Flg(Num) = False
Arr(i, 1) = Num
Flg(Num) = True
Next iBoolean型の初期値はFalse
範囲を指定して乱数を発生させてみたら、意外と多く重複していた。
重複しないように作ろうとしたところ、なかなか上手かず、ネットで調べたら
Boolean型の配列を使うというのがあった。
最初Do～Loopのところだけを見て？って思ったけど、その下の
Arr(i, 1) = Num
Flg(Num) = True
を見て納得！Boolean型の初期値はFalse。Numを配列に格納したらFlgの要素数Num番目をTrueにすれば、ループでフラグの要素数Num番目がTrueだったら重複しているので、重複しなくなるまで乱数を発生させる。
こんなフラグの使い方あるんだ！
参考サイト
www.moug.net
