[[20131202154018]]　『抽選であらかじめ決めた数字を出したい』（みな）　ページの最後に飛ぶ

『抽選であらかじめ決めた数字を出したい』（みな）

 忘年会用の抽選をエクセルで行いたいと思っているのですが、
 ボタンを押すとルーレットのように数字が回転していって、最後にあらかじめ決まった番号を当選番号として表示する方法はありますか？
 数字の総数は1～500番まで。当たりの番号はまだ総数が決まっていないのですが、20～30個あります。(たとえば1等は1本で123番、2等は2本で55番と99番など)

＜使用 Excel：Excel2003、使用 OS：WindowsXP ＞

 >最後にあらかじめ決まった番号を当選番号として表示する
 って、八百長？

 純粋な乱数のくじ引きなどであれば、学校やネットで検索するといろいろ例があると
 思いますので、まずは検索してみてはどうでしょうか。

https://www.excel.studio-kazu.jp/cgi-bin/estindex/estseek2.cgi?phrase=%E3%81%8F%E3%81%98&perpage=10&attr=&order=&clip=-1&navi=0

 のあたり目的にあったものはありませんか？

（Mook） 2013/12/02(月) 15:52

 Mookさん＞八百長･･･というか、出来レースですね。忘年会の時間短縮で、前もってあたる人が決まっています。
 調べては見たのですが、ランダムに数字を出すものはあっても、決まった数字を出すものが見当たりませんでした（探しきれませんでした）ので書き込みさせて頂きました。
（みな） 2013/12/02(月) 15:56

 前準備
 １、適当なオートシェイプを作って、名前を「カード」にしておく
 ２、A1=IF(B1="","",ROW())　と入れておく（出た数値の履歴をB列にいれてくので）
 ３、下記BINGOの値をカンマ区切りで入れる（出てくる順番通り）
 ４、カードに下記のマクロを登録する
 ５、ボタンを押す
Option Explicit
Const BINGO = "123,55,99"
Dim N As Long
Sub yao()
    Dim Fir As Long, Las As Long
    Dim s As Double
    Dim i As Long, j As Long
    Fir = 1
    Las = 500
    Randomize
    s = Timer
    With ActiveSheet.Shapes("カード")
        Do Until Timer - s > 5
            .TextFrame.Characters.Text = Int(Rnd() * Las + Fir)
            DoEvents
        Loop
        .TextFrame.Characters.Text = Split(BINGO, ",")(N)
    End With
    Range("B1").Offset(N).Value = Split(BINGO, ",")(N)
    N = N + 1
End Sub
（稲葉） 2013/12/02(月) 16:15

 稲葉さん＞できました。ありがとうございます

蛇足ながら別案なぞ。数値を高速で増加させつつ、当選番号手前から減速する表現。
番号が近くなるとドキドキしそうな方法です。

test1のほうはガチなランダムで、test2のほうは3名当選確定、4人目からはガチ。

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Const IMAX = 500
Const NMAX = 3
Const BINGO = "123,55,99"
Dim N As Long
Dim iSt As Long

 Sub test1()
    Randomize
    sDisp (Rnd() * IMAX + 1)
    N = N + 1
 End Sub

 Sub test2()
    Randomize
    If N < NMAX Then
        sDisp (Split(BINGO, ",")(N))
    Else
        sDisp (Rnd() * IMAX + 1)
    End If
    N = N + 1
 End Sub

 Sub sDisp(iNum As Long)
    Dim i As Long

    For i = iSt To iNum + IMAX
        Range("A1").Offset(N) = "'" & Right("00" & (i - 1) Mod IMAX + 1, 3)
        DoEvents
        If (IMAX - 20) < (i - iNum) Then
            Sleep Int(i - iNum - IMAX + 20) ^ 2
        Else
            Sleep 1
        End If
    Next i

    iSt = (i - 1) Mod IMAX + 1

    For i = 0 To 3
        Range("A1").Offset(N).Font.Color = RGB(255, 0, 0)
        Sleep 100
        Range("A1").Offset(N).Font.Color = RGB(255, 255, 0)
        Sleep 100
    Next i

    Range("A1").Offset(N).Font.Color = RGB(0, 0, 0)
 End Sub
（???） 2013/12/02(月) 17:27

コメント返信：

[ 一覧(最新更新順) ]

[[20131202154018]] 『抽選であらかじめ決めた数字を出したい』（みな） ページの最後に飛ぶ

[[20131202154018]]　『抽選であらかじめ決めた数字を出したい』（みな）　ページの最後に飛ぶ