妻への一風変わったプレゼント"ムーランダ"!VBA Rnd関数【IT】
今回は数年前に妻へ渡した、
一風変わったプレゼントのお話です😊
プレゼントしたのは、
Excel
です。
仕事でよく使われるMicrosoftのソフトですね。
こちらがプレゼントしたExcelのキャプチャです。

ボタンなどが付いているので、
なんとなく予想できたかもしれません。
こちらはVBAマクロを実装したExcelになります。
VBAマクロは簡単に言うと、
Excel内で動くプログラムのことになります。
Excelにボタンなどを配置しておき、
ボタンからプログラムを実行させると、
時間のかかる作業をサクッとやってくれます。
ところで、なぜこんなものを、
プレゼントすることになったのか?
平日の晩御飯の時でした。
妻がなんだか疲れていそうな顔をしていたので何かあったのか質問をしてみました。
「う〜ん。なにかあった訳じゃないんだけど、
毎年、会社のキャンペーン期間があってね。」
なるほど、キャンペーン関連🤔
「キャンペーンで抽選をするんだけど、
いつも応募されたハガキを、
袋に入れてシャッフルして、
1枚ずつ取って机に並べてるんだよね。」
なかなか原始的なやり方ですね🤔
「これが結構なハガキ数で、
2〜3時間かかるんだよね。
それが近々あって嫌なんだよね。」
2〜3時間?!😱
妻の会社は、
バグで土曜日が表示されないシステムを修正しないで使い続けたり、
未だにフロッピーディスクにデータを入れたりと、
時代錯誤な社風があるのです。
従業員からしたら、
そんな社風のせいで残業することになったら、
たまったものではありません。
私にできることはなにかを考えました。
思いついたのは、
私のIT業界での開発経験を活かした、
抽選ツールの作成です。
テスト含め、
1時間ほどでさくっと作り終わりました!
Excelの名前は、
ムーランダ
と名付けました。
Rnd関数を使って、
ランダムな数値で抽選をすることから、
業界用語のように"ム"だけを
先頭に持ってきたネーミングです笑
名前のセンスはさておき、
これで辛い思いをしなくて済みそうです✨
使い方ですが、
画面上部の[応募人数]と[当選人数上限]を入力後、[抽選開始]を押します。

抽選が終わると、メッセージが表示されます。

抽選者は[当選者結果一覧]に出力されます。

さて、使ってみた感想が気になります。
数日後、妻が嬉しそうに帰ってきました。
"めっちゃ大活躍したよ!"
Yeahhhhhhhh!!😆
ITの技術で人助けできるのは快感ですね😆
余談になりますが、
ちゃんと性能検証しています。
応募人数が10万以下であれば、
そこそこの速度で動きます。
VBAのプログラムは下記の通りとなりますので、気になる方は見てみてください。

Sub 抽選開始()
' ###初期処理###
' 変数定義
Dim lotteryNumber As Long ' 入力値(応募人数)
Dim winningNumber As Long ' 入力値(当選人数上限)
Dim winningPerson() As String ' 抽選番号出力用
Dim winNum As String ' 抽選番号
Dim roopNum As Long ' 抽選番号ループ用
Dim winningNumRandom As Long ' 当選者番号(ランダム値
Dim flg() As Boolean
' ###実処理###
' 入力値を取得する
' 抽選人数
lotteryNumber = Range("B1").Value
Debug.Print (lotteryNumber)
' 当選人数
winningNumber = Range("B2").Value
Debug.Print (winningNumber)
' 応募人数を設定する
' 初期値
roopNum = 1
Do While roopNum <= lotteryNumber
ReDim Preserve winningPerson(roopNum)
winningPerson(roopNum) = roopNum
roopNum = roopNum + 1
Loop
ReDim flg(1 To lotteryNumber)
winningNumber = winningNumber + 4
' 当選者を当選人数上限まで割り振り
Randomize
For y = 5 To winningNumber
Do
' 当選者の数だけランダム値を生成
winningNumRandom = Int(lotteryNumber * Rnd) + 1
' 重複排除
If flg(winningNumRandom) = False Then
flg(winningNumRandom) = True
Exit Do
End If
Loop Until flg(winningNumRandom) = False
' 抽選(winningPerson()のランダム番目を取得)
winNum = "抽選者番号:" & winningPerson(winningNumRandom)
' A列の当選者結果一覧へ出力
Cells(y, 1).Value = winNum
' 次の当選者割り出しへ
Next y
' 完了メッセージを表示
MsgBox "当選者一覧の選出が終わりました"
End Sub本記事のエピソードのように、私の配信するnoteは身の回りの人に笑顔になってもらうことを目標に発信しています!
心を込めたプレゼントについて、具体的な事例や詳細な制作手順を付けた有料noteを用意していますので、よろしければ読んでみてください✨
100円お試し記事!相手に気を遣わせないサプライズプレゼント
身近なアレを使った斬新な寄せ書きプレゼント!
いいなと思ったら応援しよう!
いただいたサポートは人の笑顔のために利用させていただきます。