[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『正しい解答を入れるには？』（エクセルファン北海道）
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
作業列を使います。
=IF(A3=1,$E$1,INDEX(Sheet2!$A$1:$A$2049,INT((2049 - 1 + 1) * RAND() +1))) 1位になったら、、E1を表示します。 あ１９５９ あ８１８ ううう あ１４４７ ううう =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
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
こんばんは！
さっき帰って来てよく読んでませんが、、、 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
syさんが教えて下さったやり方で「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
>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.