抽籤マクロ(Excel) - 素人がExcelVBAによる「一人働き方改革」に挑むブログ

順番の抽籤をする

研修会とかそういう機会に、発表の順序を決めるとき。

自薦方式をとったり、じゃんけんで決めてもらったりするのも良いが、Excelでやってみてもいいんではないか、と思った。

準備

次のようなシートを準備。

f:id:akashi_keirin:20190803110342j:plain

「抽籤！」ボタンをクリックすると、セルに発表グループ名（今回は番号）が表示されるようにする。

仕様

ただ発表順がいっぺんに表示されるだけだと盛り上がらないので（別に盛り上げる必要はないんだが。）、

正式表示まで番号がグルグル表示されるようにする
一つづつ、それなりに間を空けて表示されるようにする
終わったら「決定！」と表示するようにする

と、こんな感じにした。

抽籤マクロのコード

シートモジュールにメインのコードを書くことにし、乱数発生のためのモジュール（自作のRandUtilモジュール）と、WindowsAPI関数呼び出し用のクラス（自作のWinAPIクラス）をインポートして使用した。

リスト１　標準モジュールRandUtil

Option Explicit

Public Function getRandomOrder( _
            ByVal maxNumber As Long, _
   Optional ByVal allowDuplicate As Boolean = False) As Long()
'///1～maxNumまでの整数をランダムに並べて配列に格納する。'
'///引数maxNum：最大数'
'///引数allowDuplicate：重複を許可するならTrue'
  Dim ret() As Long
  Dim hasSet() As Boolean
  ReDim hasSet(maxNumber - 1)
  Dim i As Long
  ReDim ret(maxNumber - 1)
  Randomize
  Dim tmp As Long
  For i = 0 To maxNumber - 1
    Do
      tmp = Int(maxNumber * Rnd + 1)
    '///乱数：Int((最大値 - 最小値 + 1) * Rnd + 最小値)'
    Loop Until hasSet(tmp - 1) = False
    ret(i) = tmp
    If Not allowDuplicate Then hasSet(tmp - 1) = True
  Next
  getRandomOrder = ret
End Function

リスト２　クラスモジュールWindowsAPI

※必要な部分のみ。

Option Explicit
'///Attribute VB_PredeclaredId = True////'

'WindowsAPI Functions'
Private Declare Function GetTickCount Lib "kernel32" () As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

'Methods'
Public Function callGetTickCount() As Long
  Dim ret As Variant
  ret = GetTickCount()
  ret = CDec(ret)
  If ret < 0 Then ret = ret + 2 ^ 32
  callGetTickCount = ret
End Function

Public Sub callSleep(ByVal milliSeconds As Long)
  Call Sleep(milliSeconds)
End Sub

Public Sub waitFor(ByVal milliSeconds As Long)
  Dim startTime As Long
  startTime = callGetTickCount()
  Dim endTime As Long
  Do
    Call Sleep(1)
    DoEvents
    endTime = callGetTickCount()
  Loop Until endTime - startTime > milliSeconds
End Sub

リスト３　シートモジュールSh01Main

Option Explicit

Private Const AREA_ADDRESS As String = "$A$2:$F$2"

Private Enum Sh01ErrorCode
  sh01ecUnknown
  sh01ecIncorrectArg
End Enum

Public Property Get DisplayArea( _
       Optional ByVal indexOf As Long) As Range
  Const ERR_SOURCE As String = _
          "Sh01Main Property Get DisplayArea"
  '引数indexOfを省略したら範囲全体を返す'
  Dim ret As Range
  Set ret = Me.Range(AREA_ADDRESS)
  If indexOf = 0 Then GoTo Finalizer
  'ガード節：不正引数を弾く'
  If indexOf > ret.Columns.Count Then _
    Call raiseError(sh01ecIncorrectArg, ERR_SOURCE)
  '引数indexOfに応じたセルを返す'
  Set ret = ret.Cells(1, indexOf)
Finalizer:
  Set DisplayArea = ret
End Property

Private Sub setNumber()
  'グルグル表示のリピート回数'
  Const REPEAT_COUNT As Long = 8
  'グルグル表示のインターバル'
  Const DISPLAY_INTERVAL As Long = 50
  '抽選結果表示のインターバル'
  Const SHOW_INTERVAL As Long = 1000
  
  Dim targetArea As Range
  Set targetArea = Me.DisplayArea
  '一旦表示をクリア'
  Call targetArea.ClearContents
  Dim maxNumber As Long
  maxNumber = targetArea.Columns.Count - 1
  '乱数配列を取得'
  Dim order() As Long
  order = RandUtil.getRandomOrder(maxNumber, False)
  'WinAPIクラスをインスタンス化'
  Set winAPI = New WindowsAPI
  Dim i As Long
  Dim j As Long
  For i = LBound(order) To UBound(order)
    With Me.DisplayArea(i + 1)
      'グルグル表示'
      For j = 0 To (maxNumber * REPEAT_COUNT) - 1
        '0.1秒ごとに数字を表示'
        .Value = order(j Mod maxNumber)
        Call winAPI.waitFor(DISPLAY_INTERVAL)
      Next
      '結果表示'
      .Value = order(i)
      '少し間を空ける'
      Call winAPI.waitFor(SHOW_INTERVAL)
    End With
  Next
  '「決定！」表示'
  Me.DisplayArea(maxNumber + 1).Value = "決定！"
End Sub

Private Sub raiseError(ByVal errCode As Sh01ErrorCode, _
                       ByVal errSource As String)
  Dim msg As String
  Select Case errCode
    Case sh01ecIncorrectArg
      ret = "The arg ""indexOf"" is out of bound."
    Case Else
      ret = "Some error has occurred!"
  End Select
  Call Err.Raise(Number:=10000 + errCode, _
                 Source:=errSource, _
                 Description:=ret)
End Sub

例によって、現時点では特に必要でもないエラー対応なんかを入れたせいでタテ長になっている。

必要な箇所にはコメントを入れているので、細かい説明は省略。