[[20101224101016]]　『抽選の仕方』（ROR）　ページの最後に飛ぶ

 『抽選の仕方』（ROR）
 社内で抽選会を行うのですが些か困っています。
 相談にのってもらえないでしょうか？
 マクロでRange("E4") = "=INT(RAND()*(100-1)+1)"この様に書いて番号を出します。
 F4には=VLOOKUP(E4,E21:F120,2,FALSE)を書きました。
 品名は出るのですが一度出た番号が何度も出るのに気付くのが遅くて責任の重大さに悩んでいます。
 どう書いたら一度出た番号を出ないようにマクロを組めるでしょうか？
 代案でも良いので教えてください。
 Excel2003,WindowsXP

 1.別のシートのA列に１～の連番を入れ、
 　B列にランダムな番号をいれる。
 2.B列をキーにして並べ替え。
 3.上から順番にA列を取り出す。
 (semm)

 semmさん、早速のご返事ありがとうございます。
 やってみたのですが、、、今一つ意味がわからないのですが？
 (ROR）

 >一度出た番号が何度も出るのに 
 １～100がランダムに並んだ表
 2
 45
 13
 ・
 ・
 56      等々　
 を用意し、抽選とはいいながら上から順に数字を拾っていく。
 あるいは1～100の中から先ず１つの数字を選びます。次はその数字を除いた(99個の)の中から選びます。この場合、選んだ数字を順に記録した表が必要です。
 どちらの場合も１～100の数字がランダムに並んだ表を作ることになります。　　(NB)

 私だったら
Ａ列に
=RAND()
Ｂ列に
=RANK(A1,A:A,1)
Ｃ列に
=INDEX(E:E,B1)
Ｅ列に
当選者？品名？
　
を当選者？品名？の数だけ下にフィルコピー。
出来上がったらすぐさまコピーして「形式を選択して貼り付け」の「値」ペーストで式を消します。
　
そして別シートでVLOOKUPかなにかでＢ列を順位として検索をかけ、さも今抽選が行われたようにみせます（笑）
（すずめ）

 NBさん、すずめさん。
 ご返事ありがとうございます。
 すずめさんの説明よくわかります。
 でも抽選番号を乱数にしているから重複するのですがコレを一度出たら二度は出ないようにしたいのです。
 NBさんの言われたよう、あるいは1～100の中から先ず１つの数字を選びます。次はその数字を除いた(99個の)の中から選びます。この場合、選んだ数字を順に記録した表が必要です。
 この方法が分からず悩んでいます。
 （ROR）

 残りであらためて抽選するのではなく、ランダムに並んだ数字を並んでいる順に使用します。
 (semm)
 少し修正。

 これまでも説明されている内容ですが、重複無く並べ替えるサンプルです。

 Sub MakeRandList()
    Const MAX_NUM = 100

    Worksheets.Add before:=Worksheets(1)
    With Worksheets(1).Range("A1")
        .Resize(MAX_NUM, 1).Formula = "=RAND()"
        With .Offset(0, 1).Resize(MAX_NUM, 1)
            .Formula = "=ROW()"
            .Value = .Value
        End With
        .Resize(MAX_NUM, 2).Sort Key1:=Range("A1"), order1:=xlAscending
        .EntireColumn.Delete
    End With
 End Sub

 時節柄でしょうか。最近こんなのもありました。
[[20101221150415]]
 (Mook)

 >その数字を除いた(99個の)の中から選びます。この場合、選んだ数字を順に記録した表
 これが案外面倒です。VBAのことは分からないので考え方だけ。
 1
 2
 ・
 ・
 100   の表を用意します。　　配列でのよい。
 1～100のなかからランダムに｛ｎ」を選び数字はｎ番目数字(最初は「ｎ」)を選びます。その後その「ｎ」番目の数は消去します。後は２つの方法があります。
 1(関数的方法)　数字を消去した「穴」はそのままで、残った数字は99個なので１～99の乱数で「ｎ」を選べば、その99個の数字の大きい方から(あるいは小さい方から)ｎ番目の数を選びます。後はこの繰り返し。
 2 数字を消去した「穴」を詰めて99個の数字の並びを得ます。この中から「ｎ番目」の数字を選びます。後はこの繰り返し。
 2の方が簡単ですね。ｎ番目のセルを削除、上に移動でできます。　　　(NB)

 Mookさん、NBさん。ありがとうございます。
 =IF(COUNTIF($D$21:D32,D32)>1,"×","")この式をE21からE120まで書いて重複には×が出るようにしました。
 少し変更して以下のコードにしました。
 Sub 乱数()
    Range("E4") = "=INT(RAND()*(10-1)+1)"
    Range("E4").Copy
    Range("E4").PasteSpecial Paste:=xlValues
    Application.CutCopyMode = False

    Range("E4").Copy
    Range("D21").PasteSpecial Paste:=xlValues
    Application.CutCopyMode = False
 End Sub
 このコードで下に下げようとしているのですがRange("D21")が固定になってしまい下げられません。
下げる方法を教えてください。
 Sub 下に移動()
    Range("D21").End(xlDown).Select
    Selection.Offset(1, 0).Select
 End Sub
 （ROR）

 お急ぎの案件かもしれませんが、あまり回答された内容を見ていないようですね。
 すずめさんの提示した内容を理解されていないように思えますし、それを活用しようとしているようにも見えません。
 >すずめさんの説明よくわかります。
 >でも抽選番号を乱数にしているから重複するのですがコレを一度出たら二度は出ないようにしたいのです。
 は矛盾していますよ。すずめさんの方法は重複ない数値を得る解法です。

 ご自分のやり方での解決を望むのであれば、もう少し細かい状況と目的の説明が必要だと思います。

 >=IF(COUNTIF($D$21:D32,D32)>1,"×","")この式をE21からE120まで書いて重複には×が出るようにしました。
 ということは、重複がでるのはそのままにして、×が出た行を無視するということでしょうか。

 >このコードで下に下げようとしているのですがRange("D21")が固定になってしまい下げられません。
 は何をしようとしていて、何が問題かがわかりません。また、これまでの質問との関連もないように見えます。

 移動の件が、選択セルを一つ下の行に移動したいということであれば、
     Selection.Offset(1, 0).Select
 だけにすればよいかと思いますが、的外れかな？

 いずれにせよ、部分的な問題だけ解決できればよい（セルのアドレス調整はご自身でやる）のであればよいですが、
 全体としての整合性をもった回答を得たいのであれば、最低限セルをどのように使うつもりなのかの情報は必要だと思います。
 (Mook)

 Mookさん、ありがとうございます。
 本当のことを申しますと理解が今ひとつ出来ていないのです。
 重複しないことは分かりますが「何番？」とE4に出したいのをどうやって結びつけるのか分からないのです。
 >重複が出るのはそのままにして、×が出た行を無視するということでしょうか。
 これは無視しなくてOn Error GoTo で対応しようと考えています。

    Range("D21").End(xlDown).Select
    Selection.Offset(1, 0).Select
    Range("E4").Copy
    Range("D21").PasteSpecial Paste:=xlValues
 出た数字をD21から下に書き出して重複数が出たらOn Error GoTo でもう一度。と動けば目的が達せられるかと・・・思うのですが。。。
 （ROR）

 D列に表示する番号はリアルタイムに生成する必要があるのですか？

 すずめさんの式にしても、私が先に提示したマクロにしても、事前に（一度に）順番を生成するものです。

 まずは、どのようにしたいかを説明してはどうでしょうか。
 D21 以下に、乱数で決めたものをいっぺんに表示してはまずいのですか？
 ボタンか何かを押して、一つずつ表示するというようなことを想定して いるのでしょうか。

 On Error GoTo に関しては誤解（問題を複雑に）していると思いますので、いったん忘れた方が良いと思います。
 (Mook)

 リアルタイムで考えてみました。

 ※ RANDBETWEEN関数を使いますので、2003以前のバージョンは
    メニュー[ツール]→[アドイン]→[分析ツール]にチェックを入れる必要があります。

 F21セルから下に、100個の賞品名を入力しておきます。

 F4セルに右の数式を入力します。　→ =IF(E4="","",INDEX(F21:F120,E4))

  行  ___ E ___  ___F___
   3  当選番号   賞品名 
   4         2   賞品2  
   5

  20                    
  21             賞品1  
  22         2   賞品2  
  23             賞品3  
 　：　　：　　　　：

 「がらポン」マクロを実行するたびに、
  当選番号がE4セルに表示されます。(マクロのボタンに登録しておくと楽ちんです)

  Sub がらポン()
  Dim prizeLeft As Long
  Dim positionInGoodsLeft As Long
  Dim positionRow As Long

  With WorksheetFunction
     prizeLeft = 100 - .Count(Range("E21:E120"))

     If prizeLeft = 0 Then
         MsgBox "残りの賞品はありません"
         Exit Sub
     End If

     positionInGoodsLeft = .RandBetween(1, prizeLeft)
     positionRow = Evaluate("SMALL(IF(E21:E120="""",ROW(E1:E100))," & _
                                          positionInGoodsLeft & ")")
     Range("E4").Value = positionRow
     Range("E" & positionRow + 20).Value = positionRow
  End With
  End Sub

 (半平太) 2010/12/24 21:21

 Mookさん、なんとか移動して複写の件は下のコードで解決しました。
    Range("D21").End(xlDown).Select
    Range("E4").Copy
    Cells(Rows.Count, 4).End(xlUp).Offset(1).PasteSpecial Paste:=xlValues
    Application.CutCopyMode = False
 やっぱ・・・発想が悪かったのかと思い始めています・・・

 半平太さん。
 コピペして動かしてみましたがオブシェクトは、このプロパティまたはメソッドをサポートしていません。とエラーメッセージが・・・
 （ROR）

 少しは進展したようで何よりです。
 しかし私が聞きたいと思っているのは、どのように使いたいかなのです。

 これまで推測されたのは、
 (1)E4 にランダムでこれまででた（D21以降にある）数値と重複ない数値を表示する
 (2)F4 にE4 に対応する商品を表示する（VLOOKUP）
 (3)D21以降 に E4 をコピーする（VBA の処理）
 という動作を繰り返すことでしょうか。

 であるときに質問は、
 Q1 半平太さんの提示されたように、一回ずつE4に発生させたいのでしょうか。
 Q2 商品は低い順に抽選するなどが一般的な気がしますが、今回はランダムに
    抽選するのでしょうか。
 Q3 今回の仕様は「誰が」当たったかが分からないのですが、当事者が引いて
    当たった商品を得るという形なのでしょうか。

 私のスタンスとしては繰り返しですが、「何をどうしたいか」を説明ください
 ということです。
 目的（使用者がどう使いたいか）が説明されれば、それに応じた回答もできますが、
 「これはどうですか」と提示して、「いえいえ、そうではなくて・・・」と
 繰り返す時間はもうないようにも思えます。

 半平太さんのコードですが、
 > ※ RANDBETWEEN関数を使いますので、2003以前のバージョンは
 >    メニュー[ツール]→[アドイン]→[分析ツール]にチェックを入れる必要があります。
 はされましたか？
 落ち着いて一つずつ対応していくのが、結果として早道だと思いますよ。

 質問を読んでいると、下記と同一案件のようにも思えますが、別の方でしょうか。
[[20101221150415]]『抽選くじ』（えりか）
 勘違いでしたら失礼しました。
 (Mook)

 Mookさん、こんばんは。
 ハハハー、『抽選くじ』（えりか）は別人です。わたしは６０才近くの白髪一杯のおじんです。
 季節柄同じ質問が重なったなぁーと思っていました。
 ボタンを押すと数秒間色々な数字が表示されてから止まるように作りたいと思っています。
 最初はそんな風に考えてはいかなったのですが発想がふくらんで・・・考えています。

    Application.ScreenUpdating = False

    Range("E4") = "=INT(RAND()*(101-1)+1)"
    Range("E4").Copy
    Range("E4").PasteSpecial Paste:=xlValues
    Application.CutCopyMode = False

     If Range("D20") = Range("E3").Value Then
         MsgBox "最後です"
         Exit Sub
     End If

    Range("D21").End(xlDown).Select
    Range("E4").Copy
    Cells(Rows.Count, 4).End(xlUp).Offset(1).PasteSpecial Paste:=xlValues
    Application.CutCopyMode = False

     On Error GoTo エラー処理

    Do Until Range("E20") = 0 'チェック

    Call 消す
         選択

 エラー処理:

    Loop
 何とかOn Error GoTo を入れて動くようになりました。
 （ROR）

 だいぶコードが省略されているようなので、どのようにしたいのかが今もって
 見えておりませんが、解決したということでしょうか？
 提示された範囲では On Error が有効だという気もしないのですが。

 数秒間いろいろな数値が表示されて・・・というのは、リンク先にあるように
 Sleep と Loop を併用すればできるかと思います。

 ちなみにリンク先のコードを使用して、A列に番号、B列に商品を入れておけば
 それでも今回のことができそうな気もしています。

 まぁいずれにせよ、どのようにしたいかがあっての話ですが。
 (Mook)

 Mookさん、コードの省略は下記だけですよ。
 簡単な事しかできませんから、見よう見まねで。
 Sub 消す()
    Range("D21").End(xlDown).Select
    Selection.ClearContents   
 End Sub
 と、この部分は省略しましたが・・・
 Sub 選択()

 End Sub
 あとは、E3に範囲の数を入れF4に=VLOOKUP(E4,B21:C120,2,FALSE)を入れ
 D20に=COUNTA(D$21:D$120)、E20に=COUNTIF(E$21:E$120,"×")を入れます。
 そしてF21からF120まで=IF(COUNTIF($D$21:D26,D26)>1,"×","")これをコピー。
 ここまで会社で仕事しながら無い知恵を絞って考えていました。
（ROR）

 Mookさんに感謝します。
 Sleep と Loop で検索していたら見つかりました。
 http://www.geocities.jp/ttak_ask/office_docu/ec5.html
 組み合わせてできました。これってルーレットって云うんですね。発見しました。
 これで新年会にまにあいます。どうもありがとうございました。
（ROR）

 無事解決したのであれば、何よりです。
 (Mook)

コメント返信：

[ 一覧(最新更新順) ]

[[20101224101016]] 『抽選の仕方』（ROR） ページの最後に飛ぶ

[[20101224101016]]　『抽選の仕方』（ROR）　ページの最後に飛ぶ