ログインしてさらにmixiを楽しもう

コメントを投稿して情報交換！
更新通知を受け取って、最新情報をゲット！

EXCEL VBAコミュの過去に出た乱数とかぶらない数値の出し方おしえてください

ログインして参加する

  • mixiチェック
  • このエントリーをはてなブックマークに追加

過去に出た乱数とかぶらない数値の出し方おしえてください

mixiユーザー 2008年05月09日 20:57

はじめまして
今、単語テストをエクセルのマクロで簡単に作成できるようにしようと思っています。
「単語リスト」というシートに単語が縦に並んでおり
そこから例えば５１から１５０番の単語テストをテストシートというところにランダムで並べたいのです。
発生させる乱数は１から１００の間です。
わからないところなのは、前回出た数値と同じ数値が乱数で出てきてしまいます。
do until　で前に出ていないかをチェックさせているはずなのですけども、なぜかできません。
ドコがおかしいのか教えていただけると助かります。
よろしくお願いします。




最初のほうは飛ばして見ていただいて結構です。

Sub 単語()

Dim i
Dim j
Dim k
Dim l
Dim strspace
Dim intstart
Dim intend
Dim strcopy
Dim strcopy2
Dim line
Dim error
Dim wordlist
Dim testlist
Dim testtype
Dim random1
Dim random2
Dim random3
Dim compare
Dim compare2
Dim searchweek(110)






random1 = 2
random2 = 101


Worksheets("テストシート").Range("A1:D51").Delete
Worksheets("テストシート").Range("A2:D51").Font.Size = 12
Worksheets("テストシート").Range("A2:D51").Borders.LineStyle = xlContinuous

Worksheets("解答シート").Range("A1:D51").Delete
Worksheets("解答シート").Range("A2:D51").Font.Size = 12
Worksheets("解答シート").Range("A2:D51").Borders.LineStyle = xlContinuous


j = 2
line = 1
intstart = Worksheets("製作シート").Cells(3, "C")　　この変数は単語テストの初めの番号です。
intend = Worksheets("製作シート").Cells(5, "C")　　この変数は終わりの番号です。
wordlist = Worksheets("製作シート").Cells(7, "C")　　これは単語テストの名前です。例えば、英単語ターゲット１９００のテストを作るならターゲット１９００が入ります。
testlist = Worksheets("製作シート").Cells(9, "C")　　これは日本語から英語なのか、英語から日本語なのかを選択するところです。
testtype = Worksheets("製作シート").Cells(11, "C")　　これは番号順のテストかランダムのテストかを選択するところです。






If wordlist = "英単語ターゲット１９００（３訂版）" Then
wordlist = 2
ElseIf wordlist = "英単語ターゲット１９００（４訂版）" Then
wordlist = 4
ElseIf wordlist = "速読英単語・必修編（増訂第３版）" Then
wordlist = 6
End If

If testlist = "英語→日本語" Then
Worksheets("テストシート").Cells(1, "B") = Worksheets("製作シート").Cells(7, "C")
Worksheets("テストシート").Cells(1, "C") = intstart & "〜" & intend
Worksheets("テストシート").Cells(1, "D") = "Type" & " " & testtype
testlist = 1
Else
Worksheets("テストシート").Cells(1, "A") = Worksheets("製作シート").Cells(7, "C")
Worksheets("テストシート").Cells(1, "B") = intstart & "〜" & intend
Worksheets("テストシート").Cells(1, "C") = "Type" & " " & testtype
testlist = 2
End If



If testlist = 1 Then
testlist = wordlist + 1
Worksheets("テストシート").Columns("A").ColumnWidth = 17
Worksheets("テストシート").Columns("C").ColumnWidth = 17
Worksheets("解答シート").Columns("A").ColumnWidth = 17
Worksheets("解答シート").Columns("C").ColumnWidth = 17
Worksheets("テストシート").Columns("B").ColumnWidth = 32
Worksheets("テストシート").Columns("D").ColumnWidth = 32
Worksheets("解答シート").Columns("B").ColumnWidth = 32
Worksheets("解答シート").Columns("D").ColumnWidth = 32

ElseIf testlist = 2 Then
testlist = wordlist
wordlist = wordlist + 1
Worksheets("テストシート").Columns("A").ColumnWidth = 32
Worksheets("テストシート").Columns("C").ColumnWidth = 32
Worksheets("解答シート").Columns("A").ColumnWidth = 32
Worksheets("解答シート").Columns("C").ColumnWidth = 32
Worksheets("テストシート").Columns("B").ColumnWidth = 17
Worksheets("テストシート").Columns("D").ColumnWidth = 17
Worksheets("解答シート").Columns("B").ColumnWidth = 17
Worksheets("解答シート").Columns("D").ColumnWidth = 17
End If



error = intend - intstart


If error > 99 Then
MsgBox "一度に作れるのは１００個までです。"
ElseIf testtype = "番号順" Then
For i = intstart + 1 To intend + 1 Step 1
strcopy = Worksheets("単語リスト").Cells(i, wordlist)
strcopy2 = Worksheets("単語リスト").Cells(i, testlist)
Worksheets("テストシート").Cells(j, line) = strcopy
Worksheets("解答シート").Cells(j, line) = strcopy
Worksheets("解答シート").Cells(j, line + 1) = strcopy2
j = j + 1
If j = 52 Then
j = 2
line = 3
End If
Next i


大事なのはココからだと思います。


ElseIf testtype = "ランダム" Then
j = 2
For i = intstart + 1 To intend + 1 Step 1
compare2 = Int((random2 - random1 + 1) * Rnd + random1)
k = 1
Do Until k = j - 1
compare = searchweek(k)
If compare = compare2 Then
compare2 = Int((random2 - random1 + 1) * Rnd + random1)
k = 1
Else
k = k + 1
End If
Loop

searchweek(j) = compare2
Worksheets("テストシート").Cells(j, "F") = searchweek(j)
strcopy = Worksheets("単語リスト").Cells(i, wordlist)
strcopy2 = Worksheets("単語リスト").Cells(i, testlist)

If searchweek(j) <= 51 Then
line = 1
Worksheets("テストシート").Cells(searchweek(j), line) = strcopy
Worksheets("解答シート").Cells(searchweek(j), line) = strcopy
Worksheets("解答シート").Cells(searchweek(j), line + 1) = strcopy2
ElseIf searchweek(j) > 52 Then
searchweek(j) = searchweek(j) - 50
line = 3
Worksheets("テストシート").Cells(searchweek(j), line) = strcopy
Worksheets("解答シート").Cells(searchweek(j), line) = strcopy
Worksheets("解答シート").Cells(searchweek(j), line + 1) = strcopy2
End If
'Worksheets("テストシート").Cells(j, "F") = searchweek(j)
j = j + 1
Next i
End If

End Sub

コメント(14)

[1] mixiユーザー 05月09日 21:44

Do Untilの条件ですね。
jをカウントアップして、j-1になった時点でループを抜けてしまうために
最後の数字についてチェックできていないのがうまくいかない原因です。
「Do until k = j - 1」のところを、「Do until k = j」にかえれば重複なくできますよ。

[2] mixiユーザー 05月09日 22:42

A1:A100に1〜100を、B1:B100に =RAND() と入力しておき、
Ｂ列をキーに｢並べ替え｣をして、
上から50個とればいいです。

[3] mixiユーザー 05月10日 23:52

全然違う方法ですが何とかできましたあせあせ
お手数お掛けして申し訳ないですｗ
ありがとうございました。

[4] mixiユーザー 05月11日 03:37

>全然違う方法ですが何とかできました
出来ればどういった方法で解決したのかをレスしていただけるとありがたいです。

それに、やむさんやビリーさんもどういった方法で解決できたか気になると思いますしｗｗ

[5] mixiユーザー 05月11日 14:04

そうですねあせあせ（飛び散る汗）
気が利かなくて申し訳ないｗ
多少強引なやり方なのですが
ビリーさんのコメントにヒントを得てできました。
まず１〜１００の数値をどこかのシートに発生させます。
その後、その数値を乱数を使って入れ替えるという方法です。
こんな感じ↓

random1 = 1
random2 = 100
for i = 1 to 100 step 1
worksheets("テストシート").cells(i,"F") = i
next i

for i = 1 to 150 step 1
sgn1 = Int((random2 - random1 + 1)* Rnd + 1)
sgn2 = Int((random2 - random1 + 1)* Rnd + 1)
compare = worksheets("テストシート").cells(sgn1,"F")
compare2 = worksheets("テストシート").cells(sgn2,"F")
worksheets("テストシート").cells(sgn2,"F") = compare
worksheets("テストシート").cells(sgn1,"F") = comapre2
next i


テストシートの行Ｆには数値が残ってしまうので
要らなくなったらその行を全部削除しておきます。
このようにかぶらない乱数を発生させてます。

[6] mixiユーザー 05月11日 15:01

>>ケンわん♪さん
compare2とcomapre2は同じ変数だと思うのですが、合ってますか？
５のコードがコピぺなら、元のコードを修正しないと…。

[7] mixiユーザー 05月11日 15:30

あｗ
下から２行目の変数
comapre2　じゃなくて compare2　の間違いですｗｗｗ
すいませんｗｗ
ご指摘ありがとうございますｗｗ

[8] mixiユーザー 05月11日 17:45

参考までに、
自分の場合は、配列の０〜１００までを作り、それぞれに０〜１００までの値を与え、で、乱数で２つの値を取り出し、その配列を入れ替える、というやり方をしていますね。カードシャフルの方法です。
本用件に対しては役立つかわかりませんけど・・・。

'乱数初期化
Randomize

'配列の用意
dim NUM(100)
for i=0 to 100
NUM(i) = i
next i

'入れ替え
for i=0 to 1000 'とりあえず1000回ぐらい切る
r1 = int(rnd()*100)
r2 = int(rnd()*100)
tmpNum = NUM(r1)
NUM(r1) = NUM(r2)
NUM(r2) = tmpNum
next

[9] mixiユーザー 05月11日 18:16

>>8
オシイ！！すごくオシイ！！
いい案なんだけど、微妙に間違ってる。
配列は０からスタートするんで、NUM(100)ってやったら0〜100までの101個の配列が出来てしまう。
さらに、int(rnd()*100)だと最大値が99になるからNUM(100)に格納された100が固定値になってしまう。

んで、そもそも値に０は不要なんですよねｗ
>>0で乱数は1から100までって明記されていますからｗｗ

だから以下のようにする必要がある。
'乱数初期化
Randomize

'配列の用意
Dim NUM(99)
For i = 0 To 99
NUM(i) = i + 1
Next i

'入れ替え
For i = 0 To 1000 'とりあえず1000回ぐらい切る
r1 = Int(Rnd() * 100)
r2 = Int(Rnd() * 100)
tmpNum = NUM(r1)
NUM(r1) = NUM(r2)
NUM(r2) = tmpNum
Next

[10] mixiユーザー 05月11日 19:50

。ちふみん=¢さん、魔流さんのコードを基に
アクティブシートのA1〜A100に表示させてみました。

Option Explicit
Sub test()
　　'乱数初期化
　　Randomize
　　'配列の用意
　　Dim i As Integer
　　Dim NUM(99) As Variant
　　Dim buf As Variant
　　Dim r1 As Integer
　　Dim r2 As Integer
　　Dim tmpNum As Integer
　　
　　For i = 0 To 99
　　　　NUM(i) = i + 1
　　Next i
　　'入れ替え
　　For i = 0 To 1000 'とりあえず1000回ぐらい切る
　　　　r1 = Int(Rnd() * 100)
　　　　r2 = Int(Rnd() * 100)
　　　　tmpNum = NUM(r1)
　　　　NUM(r1) = NUM(r2)
　　　　NUM(r2) = tmpNum
　　Next i
　　
　　buf = Range("A1:A100")
　　For i = 1 To UBound(buf, 1)
　　　　buf(i, 1) = NUM(i - 1)
　　Next i
　　Range("A1:A100") = buf
End Sub

[11] mixiユーザー 05月11日 20:46

もう少しスマートにすることが出来ますよ！それに変数も減らせますし。

携帯からなんで間違ってたらすみません

Option Explicit
Sub test()
　　'乱数初期化
　　Randomize
　　'配列の用意
　　Dim i As Integer
　　Dim NUM(99) As Variant
　　Dim r1 As Integer
　　Dim r2 As Integer
　　Dim tmpNum As Integer
　　
　　For i = 0 To 99
　　　　NUM(i) = i + 1
　　Next i
　　'入れ替え
　　For i = 0 To 1000 'とりあえず1000回ぐらい切る
　　　　r1 = Int(Rnd() * 100)
　　　　r2 = Int(Rnd() * 100)
　　　　tmpNum = NUM(r1)
　　　　NUM(r1) = NUM(r2)
　　　　NUM(r2) = tmpNum
　　Next i
　　
　　For i = LBound(NUM) To UBound(NUM)
　　　　Cells(i + 1, 1) = NUM(i)
　　Next i
End Sub

[12] mixiユーザー 05月11日 21:10

魔流さん、ありがとうございます。

やはり、オブジェクトへのアクセスが100回ぐらいならForで廻したほうがいいですか？この辺の配列使うかどうかの判断が今の私には難しいのですよ…。

[13] mixiユーザー 05月12日 11:45

>>12
そうですね〜100回くらいであれば問題な課と思いますよ〜〜。

とりあえず1000回を超えるようであれば少し考えた方がいいですけど・・・

そこまでシビアに考えないといけない場合は一時格納した方がいいのでしょうが、シビアじゃないものに対してはFor文でまわすだけでもいいような気もしますねｗｗ

[14] mixiユーザー 05月12日 22:29

なるほど〜
わざわざドコかのシートに書いておく必要はなくて
配列を利用すればいいんですねｗ
そこまで頭が働きませんでしたｗ
勉強になります。

ログインすると、みんなのコメントがもっと見れるよ

mixiユーザー
ログインしてコメントしよう！

EXCEL VBA 更新情報

EXCEL VBAのメンバーはこんなコミュニティにも参加しています

星印の数は、共通して参加しているメンバーが多いほど増えます。

EXCEL VBA

人気コミュニティランキング

困ったときには

関連ワード

mixiで趣味の話をしよう
新規登録（無料）

このページの上部へ