[[20190224210420]] 『正しい解答を入れるには?』(エクセルファン北海道) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『正しい解答を入れるには?』(エクセルファン北海道)

Sheet1のセルA1、B1、C1、D1に次の関数を入力し、Sheet2のデータをランダムに入力させています。

=INDEX(Sheet2!$A$1:$A$2049,INT((2049 - 1 + 1) * RAND() +1))

ここからさらに、Sheet1のE1に入力したデータを必ず、Sheet1のA1〜D1のどこかのセルにランダムに入れることは可能でしょうか?

< 使用 Excel:Excel2016、使用 OS:Windows10 >


 >=INDEX(Sheet2!$A$1:$A$2049,INT((2049 - 1 + 1) * RAND() +1)) 

 質問について考える前に、以下、確認しておいた方がいいような気がします。

 A1、B1、C1、D1 ってランダムに出てくるんでしょうが、
 ランダムだから、同じになる可能性はゼロではないですけど、
 それでいいんですか?

(半平太) 2019/02/24(日) 21:31


できれば、同じにならないようにはしたいです。重複はさけたいですし、E1との重複もさけたいです。
(エクセルファン北海道) 2019/02/24(日) 21:34

 作業列を使います。

 =IF(A3=1,$E$1,INDEX(Sheet2!$A$1:$A$2049,INT((2049 - 1 + 1) * RAND() +1))) 1位になったら、、E1を表示します。
 あ1959	あ818	ううう	あ1447	ううう
   =RANK(A4,$A$4:$D$4,COLUMN(A1)) 順位をだします。				
   2	      4	      1	      3	
 0.614622718	0.790546521	0.613181361	0.759972813	=RAND() を入力しておきます。

 もう、、寝ますzzzzzzzzzzzzzzzzz
(SoulMan) 2019/02/24(日) 21:46

 ・・と確認はしたものの、数式案は難しそう(私には)・・

 冴えた人のレスをお待ちください。 m(__)m

(半平太) 2019/02/24(日) 22:52


マクロはだめなら無視してください。

Sheet1にボタンを用意して下記を登録して使います。

 Option Explicit

 Sub test()
    Dim a As Object
    Dim リスト
    Dim 正解 As String
    Dim 不正解 As String

    Set a = CreateObject("System.Collections.ArrayList")

    リスト = Sheets("sheet2").Range("A1:A10").Value
    正解 = Range("E1").Value

    Do
        不正解 = リスト(WorksheetFunction.RandBetween(1, 10), 1)
        If Not a.contains(不正解) And 不正解 <> 正解 Then a.Add 不正解
    Loop Until a.Count = 3

    a.Insert WorksheetFunction.RandBetween(0, 3), 正解

    Range("A1:D1").Value = a.toarray

 End Sub

(マナ) 2019/02/24(日) 23:49


Soulmanさんのやり方ですが、データが文字でも可能なのでしょうか?
(エクセルファン北海道) 2019/02/25(月) 08:42

A1= IF(RAND()<1/4,E1,INDEX(Sheet2!$A$1:$A$2049,INT((2049 - 1 + 1) * RAND() +1)))

B1=IF(COUNTIF(A1,E1)=0,IF(RAND()<1/3,E1,INDEX(Sheet2!$A$1:$A$2049,INT((2049 - 1 + 1) * RAND() +1))),INDEX(Sheet2!$A$1:$A$2049,INT((2049 - 1 + 1) * RAND() +1)))

C1=IF(COUNTIF(A1:B1,E1)=0,IF(RAND()<1/2,E1,INDEX(Sheet2!$A$1:$A$2049,INT((2049 - 1 + 1) * RAND() +1))),INDEX(Sheet2!$A$1:$A$2049,INT((2049 - 1 + 1) * RAND() +1)))

D1=IF(COUNTIF(A1:C1,E1)=0,E1,INDEX(Sheet2!$A$1:$A$2049,INT((2049 - 1 + 1) * RAND() +1)))
(mm) 2019/02/25(月) 13:09


 >Soulmanさんのやり方ですが、データが文字でも可能なのでしょうか?

 それ以前の問題として、

 この要件をクリアー出来ていないですが・・
  ↓
 >同じにならないようにはしたいです。重複はさけたいですし、E1との重複もさけたいです。

 mmさんのも同様と思います。

 仮にA1セルがE1と同じになった場合、

 >B1=IF(COUNTIF(A1,E1)=0,IF(RAND()<1/3,E1,INDEX(Sheet2!$A$1:$A$2049,INT((2049 - 1 + 1) * RAND() +1))),INDEX(Sheet2!$A$1:$A$2049,INT((2049 - 1 + 1) * RAND() +1))) 
  ↑
  は、これと同じですよね?
     ↓
  B1=INDEX(Sheet2!$A$1:$A$2049,INT((2049 - 1 + 1) * RAND() +1))

  それは、A1セルと重複させない数式になっていないと思います。

(半平太) 2019/02/25(月) 13:43


 2行目を作業行として使います。

 A1 =IF(A2=E1,E1,IF(COUNTIF(B2:D2,A2),INDEX(Sheet2!A:A,RANDBETWEEN(1,2049)),A2))
 A2 =IF(RANDBETWEEN(1,4)=1,E1,INDEX(Sheet2!A:A,RANDBETWEEN(1,2049)))

 B1 =IF(AND(COUNTIF($A2:A2,$E1)=0,B2=$E1),$E1,IF(COUNTIF($A2:$D2,B2)=1,B2,INDEX(Sheet2!$A:$A,RANDBETWEEN(1,2049))))
 B2 =IF(AND(COUNTIF($A2:A2,$E1)=0,RANDBETWEEN(1,4-COLUMN(A2))=1),$E1,INDEX(Sheet2!$A:$A,RANDBETWEEN(1,2049)))
 B1:B2をD1:D2までフィルコピー

 これでも100%では無いですけど、2つ被る確率は数百万分の1くらいになる筈なので、
 何百万回も実行して1度も重複を許されないほど、シビアなシステムとかでもない限り、
 問題にならないと思います。

 時間かかるので100万回は試行してませんが、20万回再計算させて1度も重複はありませんでした。

(sy) 2019/02/25(月) 16:19


 シート2に作業列を追加する案です。
 此方は2つ被る確率は天文学的数値になるので重複の事は気にしないでも良いと思います。

 シート2
 A1 =IF(A1=Sheet1!E$1,1,RAND())
 A2049までフィルコピー

 シート1
 A1 =IF(RANDBETWEEN(1,4)=1,E1,INDEX(Sheet2!A:A,MATCH(SMALL(Sheet2!B:B,1),Sheet2!B:B,0)))
 B1 =IF(AND(COUNTIF($A1:A1,$E1)=0,RANDBETWEEN(1,4-COLUMN(A1))=1),$E1,INDEX(Sheet2!$A:$A,MATCH(SMALL(Sheet2!$B:$B,COLUMN(A1)*100),Sheet2!$B:$B,0)))
 D1までフィルコピー

(sy) 2019/02/25(月) 16:54


みなさんありがとうございます。これから試し、後程報告いたします。
(エクセルファン北海道) 2019/02/25(月) 18:23

 こんばんは!

 さっき帰って来てよく読んでませんが、、、
Sheet2のB列にRandを入力しておいて、、その順位を求めて上位4位を表示します。
E1のでどこが不明ですが、、A1からD1で上位4位ですから 10位くらいにしておけば重複は防げるでしょう?

     =IF(A3=1,$E$1,INDEX(Sheet2!$A$1:$A$33,SUM(IF(RANK(Sheet2!$B$1:$B$33,Sheet2!$B$1:$B$33,0)=COLUMN(A1),ROW(A1:A33)))))
     a8	            a15	           a20	              a4	  a20 =INDEX(Sheet2!$A$1:$A$33,SUM(IF(RANK(Sheet2!$B$1:$B$33,Sheet2!$B$1:$B$33,0)=10,ROW(A1:A33))))

     4	             2	            1	              3	    =RANK(D4,$A$4:$D$4,0)
0.610150461	0.690367766	0.99078871	0.686279654 =RAND()	

 でも、もしも、、気に入らなければ、、

 =IF(A3=1,$E$1,IF($E$1=INDEX(Sheet2!$A$1:$A$33,SUM(IF(RANK(Sheet2!$B$1:$B$33,Sheet2!$B$1:$B$33,0)=COLUMN(A1),ROW(Sheet2!A1:A33)))),
INDEX(Sheet2!$A$1:$A$33,SUM(IF(RANK(Sheet2!$B$1:$B$33,Sheet2!$B$1:$B$33,0)=COLUMN(A1)+10,ROW(Sheet2!A1:A33)))),
INDEX(Sheet2!$A$1:$A$33,SUM(IF(RANK(Sheet2!$B$1:$B$33,Sheet2!$B$1:$B$33,0)=COLUMN(A1),ROW(Sheet2!A1:A33))))))
  a8	       a15	  a14	      a4	       a14=INDEX(Sheet2!$A$1:$A$33,SUM(IF(RANK(Sheet2!$B$1:$B$33,Sheet2!$B$1:$B$33,0)=10,ROW(A1:A33))))

   3	       2	       1	      4	 =RANK(D4,$A$4:$D$4,0)
0.086644311	0.296175195	0.561317119	0.082236 =RAND()

 で、この時、、Sheet2のB列に入力した乱数が非常に重要になってくるので、、

 =RAND()*RAND()

 とか、、

 こんな↓コードを標準モジュールに貼り付けておいて
Option Explicit
' システムを起動してからの時間をミリ秒単位で返す
' http://msdn.microsoft.com/ja-jp/library/cc429827.aspx
Private Declare Function GetTickCount Lib "kernel32" () As Long
' メルセンヌツイスタのパラメータ(ダイナミッククリエーターの結果)
Private Const MTN = 644, MTM = 322, MTA = 12, MTB = 7, MTC = 15, MTD = 18
Private Const MXA = &H70C20000, UMK = &H78000000, LMK = &H7FFFFFF
Private Const MKB = &H73736B80, MKC = &H6ED28000
' 補助的な定数の宣言
Private Const MTL = MTN - MTM, MTK = MTN - 1, MTJ = MTL - 1, MTP = MTN - 2
Private Const PWA = 2 ^ MTA, PWB = 2 ^ MTB, PWC = 2 ^ MTC, PWD = 2 ^ MTD
Private Const KB = MKB \ PWB, KC = MKC \ PWC
Private Const P32 = 2# ^ 32, P31 = 2 ^ 31, P22 = 2# ^ 22, P9 = 2 ^ 9
Private Const M53 = 2# ^ -53, M32 = 2# ^ -32, M30 = 2# ^ -30
' 乱数の状態
Private mt(0 To MTK), mti As Long
' 初期化の補助関数
Private Function Ri(ByRef r As Double, ByVal i As Long) As Long
    Dim s As Variant
    Dim shft As Double
    Dim a As Long
    If r >= P31 Then a = r - P32 Else a = r
    a = a Xor Int(r * M30)
    If a < 0 Then r = a + P32 Else r = a
    s = 1812433253 * CDec(r) + i: r = s - CDec(Int(s * M32)) * P32
    If r >= P31 Then Ri = r - P31 Else Ri = r
End Function
' s を種にして乱数を初期化する
Public Sub InitMt(ByVal s As Long)
    Dim r As Double
    mt(0) = s And &H7FFFFFFF
    If s < 0 Then r = P32 + s Else r = s
    For mti = 1 To MTK: mt(mti) = Ri(r, mti): Next mti
    mti = MTN
End Sub
' 31 ビットの整数乱数
Public Function NextMt() As Long
    Dim y, k As Long
    If mti = 0 Then InitMt (1)
    If mti = MTN Then
        mti = 0
        For k = 0 To MTJ
            y = (mt(k) And UMK) Or (mt(k + 1) And LMK)
            mt(k) = mt(k + MTM) Xor (y \ 2) Xor (-(y And 1) And MXA)
        Next k
        For k = MTL To MTP
            y = (mt(k) And UMK) Or (mt(k + 1) And LMK)
            mt(k) = mt(k - MTL) Xor (y \ 2) Xor (-(y And 1) And MXA)
        Next k
        y = (mt(MTK) And UMK) Or (mt(0) And LMK)
        mt(MTK) = mt(MTM - 1) Xor (y \ 2) Xor (-(y And 1) And MXA)
    End If
    y = mt(mti): mti = mti + 1
    y = y Xor (y \ PWA): y = y Xor ((y And KB) * PWB)
    y = y Xor ((y And KC) * PWC): y = y Xor (y \ PWD): NextMt = y
End Function
' 0 以上 1 未満の乱数を返す
Public Function NextUnifMt() As Double
    Dim x As Long
    x = NextMt \ P9: NextUnifMt = (NextMt * P22 + x) * M53
End Function
' 時間を種にして乱数を初期化する
Public Sub RandomizeMt()
    InitMt (GetTickCount())
End Sub

 =NextUnifMt()*RAND()

 とか、、要は、、B列の間で同じ乱数がなければ順位は重複しませんので、、

 それから、、

 >できれば、同じにならないようにはしたいです。重複はさけたいですし、E1との重複もさけたいです。
 (エクセルファン北海道) 2019/02/24(日) 21:34

 で、

 >もう、、寝ますzzzzzzzzzzzzzzzzz
(SoulMan) 2019/02/24(日) 21:46

 12分、、なんで、、私からすれば、、何のこと???ってわけで、、決して、、見逃したわけではないので、、

 それから、、私が示すコードとか式はあくまでも サンプル ですから、、よく内容を理解して応用して頂けると助かります。

 >Soulmanさんのやり方ですが、データが文字でも可能なのでしょうか?

 平日は、、基本的にお返事できません。そういう意味では、、週末に回答し過ぎましたね。。反省です。

 でも、、ついつい、、反応しちゃうんですよね(^^;

 それと、、他の板ですけど、、こんなコードも書きましたね。

 リンクが貼れないのか?忘れちゃったのか??ここで SoulMan と検索していただければ、、出ます。

 よかったら参考にしてください。。

http://excelfactory.net/excelboard/excelvba/cfs.cgi

 さっさっと、、小走りで書きましたので、、、乱文、、失礼します。m(__)m

 では、では、
 あっ、、式の多くは配列です。
(SoulMan) 2019/02/25(月) 20:18

mmさんから教えていただいたやり方で、自分がやりかったことができたことを報告いたします。
ありがとうございます。

syさんが教えて下さったやり方で「2行目を作業行として使います。」の方をもう少し教えていただけたらと思っているのですが、作業列を2行目ではなく、F1〜I1で行う数式で教えていただけないでしょうか。エクセルが不慣れなため、教えていただければ助かります。
(エクセルファン北海道) 2019/02/25(月) 20:31


 簡単な修正方法は、

 まず私の提示した通りに数式を入力して下さい。
 出来た表から、A2〜D2の4つのセルを選択して切取、
 F1に貼付。
 G1から右がエラーになるので、G1の式中の COLUMN(F1) を COLUMN(A1) に変更。
 G1をI1までフィルコピー。

 この手順で数式の参照先は自動で変更されてる筈です。

 でもmmさんの式で良いなら、
 A1 =IF(RANDBETWEEN(1,4)=1,$E1,INDEX(Sheet2!$A:$A,RANDBETWEEN(1,2049)))
 B1 =IF(AND(COUNTIF($A1:A1,$E1)=0,RANDBETWEEN(1,4-COLUMN(A1))=1),$E1,INDEX(Sheet2!$A:$A,RANDBETWEEN(1,2049)))
 D1までフィルコピー
 ちょっと間違ってたので修正しました。

 でも確率的には全く同じ理論値は 1/2049 ですよ。
 作業列1つ目案の理論値は 1/4198401 です。
 2つ目の案は理論値 1/10の1500乗(0が1500個) です。

(sy) 2019/02/25(月) 22:44


 A  と Bで 1/2049 ですけど、
 A,B と Cで 2/2049
 A.B,Cと Dで 3/2049 ですから、都合 6/2049 にならないですか?

(半平太) 2019/02/25(月) 22:58


syさん、やり方を教えていただきありがとうございます。
その通りやってみたところできました。
(エクセルファン北海道) 2019/02/25(月) 23:10

 >A.B,Cと Dで 3/2049 ですから、都合 6/2049 にならないですか?
 あっ!半平太さんのおっしゃる通りでした。
 すいません。

 因みにEXCELの乱数は機械的に出してるので、理論値よりも低くなる可能性があるらしいです。
 ネットでさらっと読み流しただけなので、正確にはどれくらいと言われたら分からないですが、
 mmさんの式や私の作業列無しの式では、重複が出るまで再計算を1セットとして100回くらい試行すると、
 どちらも平均450回くらいで重複が出ました。

 6/2049 は、342 だから 理論値よりなぜか優秀ですね。
 もっと試行回数増やせば、理論値に近づくのかな?

(sy) 2019/02/25(月) 23:29


コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.