このマクロは、ワークシートに入力した住所録のデータから、指定した人数を無作為に選び出すマクロです。
マクロの実行は、ワークシートに貼り付けたコマンドボタンのClickイベントプロシージャで行います。
マクロの先頭で、抽出する人数をユーザーに入力してもらいます。人数の入力にはインプットボックスを使い、指定したセル範囲からその人数分の指名を抜き出します。指名の抜き出しには乱数を使用して、ランダムにセル番地を作成します。ただし、同じ人が何回も選ばれないように、一度抽出した氏名のセルと同じ行にある他の列のセルに*マークを付け、そのマークのない人を選ぶようにしています。
1.
コード全文
Private Sub CommandButton1_Click()
Dim Ret As Integer, i As Integer, Num As Integer
i = 0
On Error GoTo FAIL
Num = CInt(InputBox("当選者は何人にしますか？（20人以下）"))
If Num > 20 Then
MsgBox ("20人以下を入力して下さい")
GoTo FAIL
End If
Columns("F:F").ClearContents
While i < Num
Ret = Int((20 * Rnd) + 1) + 1
If Cells(Ret, 4).Value <> "*" Then
Cells(Ret, 4)
= "*"
i = i + 1
Cells(Ret,
1).Copy Destination:=Cells(2 + i, 6)
End If
Wend
Columns("D:D").ClearContents
Range("A1").Select
FAIL:
End Sub
2.ワークシートの準備
まずはじめに、ワークシートに氏名一覧を入力しておきます。ここでは、20人分の住所録を使います。郵便番号や住所が入力されていますが、使用するのは氏名の列だけです。
そして、データが入力されている最後の列の隣の列（この例では列「D」）の文字色をセルの塗りつぶし色にしておきます（ここでは白色）。というのも、この列に一度抽出されたことを記す*マークを入力するためです。このマークはすぐに消しますが、他人には見えないようにするためです。
そして、その横にコマンドボタンを1つ配置します。
ワークシートに配置した「抽選開始」ボタンを押すと、抽出する人数を入力するインプットボックスが表示されますので、ここに人数を入力します。
OKボタンを押すと、乱数を使って無作為にセル番地を作成し、そのA列にある氏名をコピーします。
3.コードの作成
最初に変数を3つ用意します。
Dim Ret As Integer, i As Integer, Num
As Integer
１つは乱数が作成する数値を整数に変換した値を格納する変数「Ret」で、もう1つはループ処理のカウンタに使用する変数「i」、最後はインプットボックスに入力された人数を格納する変数「Num」です。
また、変数iを0に初期化しておきます。
i = 0
|
次は、インプットボックスを表示し、抽出する人数をユーザーに入力してもらいます。インプットボックスの表示は、InputBox関数を使用します。この関数は、引数に表示文字列を指定し実行すると、1行入力フィールドと「OK」「キャンセル」の2つのボタンを持った小さなダイアログボックスを表示します。
そして、OKボタンを押すと1行入力フィールドに入力された値を、キャンセルボタンを押すと空白の文字列を関数の戻り値として返してきます。
これを、変数Numで受け取ります。
Num = (InputBox("当選者は何人にしますか？（20人以下）"))
ただし、OKボタンを押したときに返ってくる値はすべて文字列で、数値データが入力されても「数字」として返ってきます。そこで、数字を整数値データに変換する関数「CInt」と組み合わせ、整数値に変換してから変数Numに格納します。
Num = CInt(InputBox("当選者は何人にしますか？（20人以下）"))
ここで問題になるのが、ユーザーが数字を入力せずに、「あ」とか「へ」とか、「A」「B」などの文字を入力してしまった場合です。こうなると、文字列を整数に変換する関数CIntはエラーになってしまいます
。また、キャンセルボタンが押された場合も同様で、InputBox関数が返してくる空白の文字列を整数に変換できませんから、やはりこの式はエラーになります。
そこで、ここにエラー処理ステートメントである「On
Error 」ステートメントをセットしておきます。
On Error GoTo FAIL
Num = CInt(InputBox("当選者は何人にしますか？（20人以下）"))
もう1つ、エラー処理を用意します。それは、もしちゃんと数字が入力された場合でも、その数字が、セルに入力されている人数よりも多い場合です。この場合は、正しい抽出が行われませんから、入力値を減らすようなメッセージボックスを表示して、このClickイベントプロシージャを終了させます。
If Num > 20 Then
MsgBox ("20人以下を入力して下さい")
GoTo FAIL
End If
インプットボックスに問題なく数字が入力された場合は、その数字分セル番地を作成します。
まず、抽出した氏名を入力する欄をすべて消去しておきます。ここでは、列Fがその列なので、これを操作対象に指定し、ClearContentsメソッドを実行します。
Columns("F:F").ClearContents
次に、Whileループを用意します。ループの回数はインプットボックスで入力された人数「Num」です。
While i < Num
そして、セル番地を作成します。まず、Rnd関数とInt関数を組み合わせ、乱数を発生させてその値を整数値に変換します。次の式は20とおりの乱数を発生させる式です。もし100通りの乱数を発生させたければ、式の中の「20」を「100」に変えるだけです。
式の結果は、変数「Ret」に格納しておきます。
Ret = Int((20 * Rnd) + 1) + 1
乱数ができたら、それをCellsプロパティの「行」の位置にセットし、その位置のD列のセルの値を調べます。もしここに「*」マークが入っていなければ、そのセルははじめて抽選されたので、その位置に「*」マークをいれるとともに、その行のA列の氏名を列Fにコピーします。
そして、ループのカウンタ変数iを1つ増やしておきます。
If Cells(Ret, 4).Value <> "*" Then
Cells(Ret, 4)
= "*"
i = i + 1
Cells(Ret,
1).Copy Destination:=Cells(2 + i, 6)
End If
Wend
この処理は、ループのカウンタ変数iが変数Num未満である限り繰り返されます。すなわち、インプットボックスに入力した人数分繰り返され、氏名の抽出が行われることになります。
人数分の抽出が完了したら、*マークを付けたセルの値を削除し、セルA1を選択状態にして終了します。
Columns("D:D").ClearContents
Range("A1").Select
FAIL:
End Sub
最後に、On ErrorステートメントやGoToステートメントでのジャンプ先となるラベル「FAIL」を作成して出来上がりです。
|
