教えて!gooグレードポイントがdポイントに!

4月4日に数字4桁のパターンの作り方を質問し、
回答を頂き、4桁は解決しました。
(QNo.2893813 数字4ケタのパターンをつくりたいのですが・・ )

今度は5桁と10桁のパターンを作りたいです。
(「乱数を作りたい」といった言い方が正しいのかもしれません)

■5桁の数:1~9までの数字の中から作る

<例>14762、98426、39175、87214、、

■10桁の数:1~10の数字から作る

<例>1 3 4 8 9 2 5 7 6 10


どちらも、かぶらないように100~200パターンほど作りたいです。
エクセルの関数で出来る様ですが、エクセルはど素人なので、
前回の質問QNo.2893813 の回答no.5のようなプログラム自体をコピー&ペーストしてできるものが嬉しいです。

以下、前回頂いた回答の一部です
※回答いただいた方のお名前と、プログラムはここでは伏せます

---------------------------------------------------------------
作り方
Excelを起動→ツール→マクロ→visiual basic editor
Visual Basic で 挿入→標準モジュール
出てきた画面に下のプログラムをコピー、ペースト

使い方
Excelでツール→マクロ→マクロ
『test』を選択して実行作り方
Excelを起動→ツール→マクロ→visiual basic editor
Visual Basic で 挿入→標準モジュール
出てきた画面に下のプログラムをコピー、ペースト




質問が2回に分かれる形になってしまい、申し訳ありません。
知っている方いらっしゃいましたら、教えてください。

教えて!goo グレード

A 回答 (2件)

5桁に関しては前のプログラムを少し変更するだけで大丈夫です。


10桁も変更だけで対応できますがさすがにメモリの無駄遣いなので方法を変えています。
(表示方法も変えました。10がありますから数字で表記は無理です。)

1.五桁 内容は以前と同じ

Sub test2()
Dim Numset(15119) As Long, ct As Long
Dim ct1 As Long, temp As Long, rndno As Long
Randomize
For ct = 12345 To 98765
If handan(ct) Then Numset(ct1) = ct: ct1 = ct1 + 1
Next
For ct = 0 To 15118
rndno = Int(Rnd() * (15120 - ct))
temp = Numset(rndno)
Cells(ct + 1, 1) = temp
Numset(rndno) = Numset(15119 - ct)
Numset(15119 - ct) = temp
Next
Cells(15120, 1) = Numset(0)
End Sub
Private Function handan(num As Long) As Boolean
Dim ct As Integer, data(4) As Integer, kake As Long
For ct = 0 To 4
data(ct) = Int((num Mod 10 ^ (5 - ct)) / 10 ^ (4 - ct))
Next
kake = (data(0) - data(1)) * (data(0) - data(2))
kake = kake * (data(0) - data(3)) * (data(1) - data(2))
kake = kake * (data(1) - data(3)) * (data(2) - data(3))
kake = kake * data(0) * data(1) * data(2) * data(3) * data(4)
kake = kake * (data(0) - data(4)) * (data(1) - data(4))
kake = kake * (data(2) - data(4)) * (data(3) - data(4))
If kake Then handan = True: Exit Function
handan = False
End Function

2.10桁 一応、ランダムになるはずです。300個表示します。

Sub test3()
Dim Numset(299, 9) As Integer
Dim kakuSuji(9) As Integer
Dim kakunin(299) As Double, sum As Double
Dim ct As Integer, ct1 As Integer, temp As Integer, rndno As Integer
Dim flg As Boolean
Randomize
For ct1 = 0 To 9
kakuSuji(ct1) = ct1
Next
Do While ct < 300
For ct1 = 0 To 8
rndno = Int(Rnd() * (10 - ct1))
temp = kakuSuji(rndno)
kakuSuji(rndno) = kakuSuji(9 - ct1)
kakuSuji(9 - ct1) = temp
Next
sum = 0#: flg = True
For ct1 = 0 To 9
sum = sum / 10 + kakuSuji(ct1)
Next
For ct1 = 0 To ct - 1
If kakunin(ct1) = sum Then flg = False
Next
If flg Then
kakunin(ct) = sum
For ct1 = 0 To 9
Numset(ct, ct1) = kakuSuji(ct1) + 1
Next
ct = ct + 1
End If
Loop
Range(Cells(1, 1), Cells(300, 10)) = Numset()
End Sub
    • good
    • 0
この回答へのお礼

うまくできました!!とても助かりました。
2度もご回答していただき、本当にありがとうございました!!

お礼日時:2007/04/09 15:31

5桁の数字だったら



http://okwave.jp/qa2893813.html

これの#3さんの方法で出来ますよね。1000個の数字ではなく10000個
の数字を作るだけです。同じ考え方でVBAも直せます。

ただ、10桁の数字の場合は行数がオーバーフローしますので、
#3さんの方法だとダメですね。VBAならできるとは思いますが、
計算にかなり時間がかかりそうです。

これらの方法は「考えられる全ての組合せを先に作っておき、
それらからランダムに抜き出す」という方法を使っています。
この方法だと「全ての組み合わせ」と言う点で、桁数が増えると
行き詰まります。ですので考え方を変えて、とにかく作ってみて
重なっているのを消す・・・という方法を考えてみました。

縦:組み合わせが必要となる個数+適当な個数分の行(仮に100行)
横:必要な数字の個数(仮に10列)

この範囲について

=INT(RAND()*10+1)

これを全てコピーします。すると、行単位で求める組み合わせが出来
ますが、単純に乱数を使っているので、重複している組み合わせが
存在します。

そこで、こいつを「コピー」、「形式を選択して貼り付け」のダイアログで
「値」としてどこかに貼り付け(仮にAA1とします)、表示されたデータを
数値にしてしまいます。

その上で、Z1に =AA1&AB1&AC1&・・・&AJ1 とし、Z列でソートをかけます、
そうすると、同じ組み合わせが上下に並びますので、違う組み合わせが
目視で抽出することが出来ます。

同じ組合せを探すのが大変ならば、X1に =if(Z1=Z2,"不要","") として
コピーすれば、「不要」と表示された組み合わせは重複してますので
採用しなければオッケーです。
    • good
    • 0
この回答へのお礼

私のエクセル能力では、、
ちょっと難しくてうまくできませんでしたが、参考になりました。
どうもありがとうございました。

お礼日時:2007/04/09 15:26

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

教えて!goo グレード

人気Q&Aランキング