[[20150501144750]]　『エクセルで抽選作業をしたい』（Arieｌ）　ページの最後に飛ぶ

『エクセルで抽選作業をしたい』（Arieｌ）

営業所の社員全40,000名から、商品を5,000円以上購入した2,500名の当選者を決めたいです。
営業所は1,500箇所あります。
営業所に1人は、必ず当選させたいです。

A列　　　　　　　　　B列　　　　C列　　
営業所コード　　　　氏名　　　　購入額

ご教授いただけますでしょうか

※書き方を間違えたため、再度書き直しました。

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

 当選本数がわからんと答えられないんじゃない？
 全員が購入額上回ったら、60%の人が当選する計算になるし
 そもそも営業所に必ず一人ってランダムじゃないじゃあん
（稲葉） 2015/05/01(金) 15:12

 D1を「一定額」
 E1を「当選本数」として
 D2=IF(C2>$D$1,IF(COUNTIFS(A:A,A2,C:C,">" & $D$1)=1,ROW(A1),RANDBETWEEN(100,E$1*100)+ROW()*0.01),"")
 E2=IF(ROW(A1)<=$E$1,INDEX($B$2:$B$17,MATCH(SMALL($D$2:$D$17,ROW(A1)),$D$2:$D$17,0)),"")

 でどうだろう！？
 関数苦手だから、エキスパートさんの解答待ったほうがいいとは思いますが・・・

 __[A]________[B]_____[C]____[D]____[E]                          
営業所コード  氏名   購入額  500     10
   aaa        あ    1000    313.02  う
   aaa        い    1000    659.03  こ
   bbb        う    1000    3       さ
   bbb        え     500            そ
   ccc        お     500            あ
   ccc        か     500            す
   ddd        き    1000    843.08  し
   ddd        く    1000    704.09  い
   eee        け    1000    916.1   た
   eee        こ    1000    188.11  く
   fff        さ    1000    226.12    
   fff        し    1000    541.13    
   ggg        す    1000    504.14    
   ggg        せ    1000    902.15    
   hhh        そ    1000    251.16    
   hhh        た    1000    701.17    
（稲葉） 2015/05/01(金) 15:38

 こっちの解答に返事もしねーで、あげてばっかいるんじゃねえ！
（稲葉） 2015/05/01(金) 18:10

 コメントへの回答は質問文を修正するだけでなく、コメントでも回答した方が良いか
 と思います。いらぬ誤解を招くことにもなりますので。

 マクロの使用の可否はわかりませんが、マクロ案です。

 Sub Sample()
    Columns("D").ClearContents
    Dim tbl
    tbl = Range("A1", Cells(Rows.Count, "A").End(xlUp)).Resize(, 4)

    Dim objSLPrelim
    Set objSLPrelim = CreateObject("System.Collections.SortedList")

 '// 予備抽選
    Dim r As Long
    For r = 2 To UBound(tbl)
        If tbl(r, 3) >= 5000 Then objSLPrelim.Add Rnd(), r
 '//     If tbl(r, 3) >= 5000 Then objSLPrelim.Add (10 ^ 4 * Rnd()) / tbl(r, 3), r  '// 購入金額を加味した場合
    Next

    Dim objSLFinal
    Set objSLFinal = CreateObject("System.Collections.SortedList")

    Dim objDic
    Set objDic = CreateObject("Scripting.Dictionary")

 '// 本抽選
    Dim c As Long
    Dim branchName As String
    For c = 0 To objSLPrelim.Count - 1
        r = objSLPrelim.GetByIndex(c)
        branchName = tbl(r, 1)
        If objDic.Exists(branchName) Then
            objDic(branchName) = objDic(branchName) + 1
        Else
            objDic(branchName) = 1
        End If

        objSLFinal.Add objDic(branchName) * 10 ^ 4 + Rnd(), r
    Next

 '// 結果出力
    For c = 0 To objSLFinal.Count - 1
        If c = 2500 Then Exit For  '// 当選人数

        r = objSLFinal.GetByIndex(c)
        tbl(r, 4) = "当選"
    Next
    Range("A1", Cells(Rows.Count, "A").End(xlUp)).Resize(, 4) = tbl
 End Sub

（Mook） 2015/05/02(土) 10:47

コメント返信：

[ 一覧(最新更新順) ]

[[20150501144750]] 『エクセルで抽選作業をしたい』（Arieｌ） ページの最後に飛ぶ

[[20150501144750]]　『エクセルで抽選作業をしたい』（Arieｌ）　ページの最後に飛ぶ