ExcelのINDEX関数とRANDBETWEEN関数で抽選アプリを作成

簡単に抽選アプリを作成

抽選アプリといえるほどのものではないけど、４０００人くらいから、ランダムに人を抽出する仕組みを作ってくれと。

いつも、簡単でいいからと言われるけど。この簡単にって。ねぇ。

色々と仕様だししないといけないけど。ま、とりあえず片手間でExcel関数を利用して簡単に考えてみました。

この記事でできる事

Excelを使ってランダム人を抽出する

抽選者氏名が１列に並んでいる

抽選者からランダムに名前を抽出する

この記事でできる事追記

抽出された方の補足情報表示

抽選ボタンをマクロで作る

抽選結果を関数で表す

INDEX関数

範囲の中から、指定された値を出す

=INDEX(範囲,上から何番目)

RANDBETWEEN関数

整数範囲の中から、ランダムに整数を返す

=RANDBETWEEN(数値1,数値2)

COUNTA関数

文字列を含めてセルに文字が入っていたらカウントする

=COUNT(範囲)

抽選関数

=INDEX(A2:A3632,RANDBETWEEN(1,COUNTA(A:A)-1))

解説１

COUNTA(A:A)-1

A列に入っているデータ数をカウントする

１行目に項目があり

連続した行にデータが入っている

連続したデータの最終行番号を取得する

解説２

RANDBETWEEN(1,COUNTA(A:A)-1)

１からデータのある最終の行番号の中で、ランダムに行番号を返す

解説３

=INDEX(A2:A3632,RANDBETWEEN(1,COUNTA(A:A)-1))

A2からA3632の範囲で、RANDBETWEEN関数で返された行を返す

再抽選

F9キーを押すと、再計算されます。

再計算されるとランダム関数の値が変わるので、抽選結果が変わります。

Excelを閉じて開き直しても同じです。抽選結果が変わります。

補足情報を表示する

INDEX関数プラスMATCH関数

=INDEX(A:B,MATCH(D2,B:B,0),1)

vlookup関数では一番左に検索するための値が必要になりますが、INDEX + MATCHを利用する事により、表の一番左になくても検索できるようになります。

解説

MATCH

指定した範囲内で、どの位置にあるか列・行番号を返す関数

抽選ボタンを作る

F9ボタンを押して再計算させてもいいのですが、もうちょこっとだけいい雰囲気にしたいって事でマクロを登録してみたいと思います。

図形描画で、抽選ボタンを作り、その上で右クリック、マクロを登録します。

マクロ上でF9を連打して終了します。

F9はVBAでは、Calculateという構文になります。

Sleepさせる

F9連打をそのまま実行すると、動作が早すぎるので、F9の間にSleepを入れるようにします。

マクロの登録画面から、編集ボタンをクリックしてVBAのエディタを起動します。

VBAの一番上に

Private Declare Sub Sleep Lib “kernel32” (ByVal ms As Long)

が必要になります。

そして、Sleep ○○ミリ秒を指定します。

Dim time As Long
time_01 = 100
time_02 = 500
time_03 = 700

Calculate
    Sleep time_01
Calculate
    Sleep time_02
Calculate
    Sleep time_03

このように指定する事で、ルーレットのように段々遅くなるように表示が可能です。

VBA全文

抽選中、ボタンの色を変えるなどを加えたマクロ全文です。

Private Declare Sub Sleep Lib "kernel32" (ByVal ms As Long)


Sub 抽選4_click()
'
' 抽選4_click Macro
'

    
    Dim time As Long
    time_01 = 100
    time_02 = 500
    time_03 = 700

    'ボタンの色を変える
    ActiveSheet.Shapes.Range(Array("Rounded Rectangle 1")).Select
    Selection.ShapeRange.ShapeStyle = msoShapeStylePreset10
'
    Range("S2").Select
    
    Calculate
    Sleep time_01
    Calculate
        Sleep time_01
    Calculate
        Sleep time_01
    Calculate
        Sleep time_01
    Calculate
        Sleep time_01
    Calculate
        Sleep time_01
    Calculate
        Sleep time_01
    Calculate
        Sleep time_01
    Calculate
        Sleep time_01
    Calculate
        Sleep time_01
    Calculate
        Sleep time_01
    Calculate
        Sleep time_01
    Calculate
        Sleep time_01
    Calculate
        Sleep time_01
    Calculate
        Sleep time_01
    Calculate
        Sleep time_01
    Calculate
        Sleep time_01
    Calculate
        Sleep time_01
    Calculate
        Sleep time_01
    Calculate
        Sleep time_02
    Calculate
        Sleep time_02
    Calculate
        Sleep time_02
    Calculate
        Sleep time_03
    Calculate
    
        'ボタンの色を戻す
        ActiveSheet.Shapes.Range(Array("Rounded Rectangle 1")).Select
        Selection.ShapeRange.ShapeStyle = msoShapeStylePreset12

    Range("S2").Select
    
End Sub

 

まとめ

Excelの関数は優秀ですね。VBA、マクロ登録もとっても簡単にプログラムチックな事ができます。Microsoftさんへ感謝。