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

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

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

  • mixiチェック
  • このエントリーをはてなブックマークに追加
はじめまして
今、単語テストをエクセルのマクロで簡単に作成できるようにしようと思っています。
「単語リスト」というシートに単語が縦に並んでおり
そこから例えば51から150番の単語テストをテストシートというところにランダムで並べたいのです。
発生させる乱数は1から100の間です。
わからないところなのは、前回出た数値と同じ数値が乱数で出てきてしまいます。
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")  これは単語テストの名前です。例えば、英単語ターゲット1900のテストを作るならターゲット1900が入ります。
testlist = Worksheets("製作シート").Cells(9, "C")  これは日本語から英語なのか、英語から日本語なのかを選択するところです。
testtype = Worksheets("製作シート").Cells(11, "C")  これは番号順のテストかランダムのテストかを選択するところです。






If wordlist = "英単語ターゲット1900(3訂版)" Then
wordlist = 2
ElseIf wordlist = "英単語ターゲット1900(4訂版)" Then
wordlist = 4
ElseIf wordlist = "速読英単語・必修編(増訂第3版)" 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 "一度に作れるのは100個までです。"
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)

Do Untilの条件ですね。
jをカウントアップして、j-1になった時点でループを抜けてしまうために
最後の数字についてチェックできていないのがうまくいかない原因です。
「Do until k = j - 1」のところを、「Do until k = j」にかえれば重複なくできますよ。
A1:A100に1〜100を、B1:B100に =RAND() と入力しておき、
B列をキーに「並べ替え」をして、
上から50個とればいいです。
全然違う方法ですが何とかできましたあせあせ
お手数お掛けして申し訳ないですw
ありがとうございました。
>全然違う方法ですが何とかできました
出来ればどういった方法で解決したのかをレスしていただけるとありがたいです。

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

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


テストシートの行Fには数値が残ってしまうので
要らなくなったらその行を全部削除しておきます。
このようにかぶらない乱数を発生させてます。
>>ケンわん♪さん
compare2とcomapre2は同じ変数だと思うのですが、合ってますか?
5のコードがコピぺなら、元のコードを修正しないと…。
あw
下から2行目の変数
comapre2 じゃなくて compare2 の間違いですwww
すいませんww
ご指摘ありがとうございますww
参考までに、
自分の場合は、配列の0〜100までを作り、それぞれに0〜100までの値を与え、で、乱数で2つの値を取り出し、その配列を入れ替える、というやり方をしていますね。カードシャフルの方法です。
本用件に対しては役立つかわかりませんけど・・・。

'乱数初期化
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

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

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

だから以下のようにする必要がある。
'乱数初期化
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
。ちふみん=¢さん、魔流さんのコードを基に
アクティブシートの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
もう少しスマートにすることが出来ますよ!それに変数も減らせますし。

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

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
魔流さん、ありがとうございます。

やはり、オブジェクトへのアクセスが100回ぐらいならForで廻したほうがいいですか?この辺の配列使うかどうかの判断が今の私には難しいのですよ…。
>>12
そうですね〜100回くらいであれば問題な課と思いますよ〜〜。

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

そこまでシビアに考えないといけない場合は一時格納した方がいいのでしょうが、シビアじゃないものに対してはFor文でまわすだけでもいいような気もしますねww
なるほど〜
わざわざドコかのシートに書いておく必要はなくて
配列を利用すればいいんですねw
そこまで頭が働きませんでしたw
勉強になります。

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

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

EXCEL VBA 更新情報

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

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