A 回答 (6件)
- 最新から表示
- 回答順に表示
No.6
- 回答日時:
ちょっと拝見させていただきました。
本題は、よく見ると、#4さんご指摘のように、乱数の重複を出さないという目的の元に作られたものでしょう。
ただ、ご質問者さんのコードで、つまらないことを言いますが、Lisp とかではありませんから、関数のネストはやめたほうがよいです。かなり可読性が落ちます。ネストの中で、Double型の数値を取り扱っていますから、実際にも不安を感じさせます。
今回、Int(Rnd()*(Ud-Ld+1)) + Ld も、そのままというわけにもなかなか行かないのは、もう#4さんのコードで実証済みですね。
この他にも、Collectionを使った技法があります。今回は、前々から懸念のメルセンヌ・ツイスターを導入して使ってみました。このレベルでは特に変化があるわけではありませんが、それでも、あまり、Microsoft のPRNのRand()/Rnd() に依存していくこともできないと思います。あまりにも、過去、信用をなくしましたからね。
なお以下、不手際がありましたら、臨機応変にお願いします。
注意:シート2をお使いなら、シート2をアクティブシートにしてお使いください。
'//
Sub RandomGeneration_02()
Dim i As Long, j As Long
Dim m As Long, n As Long
Dim x()
Dim y()
Dim d()
Const Ld = 1000
Const Ud = 9999
Const Pd = 342 'これはSize違い(不要)
Dim k As Long
Dim a As Long
Dim xa As Double 'Double型の不安は残る
k = Ud - Ld + 1
ReDim x(1 To k)
ReDim y(1 To k)
'貼付け用の変数 "B1:K54"
ReDim d(1 To 54, 2 To 11)
Randomize
For i = 1 To k
x(i) = Rnd() '*<-> genrandm() 'メルセンヌ・ツイスタ
y(i) = i + Ld - 1
Next i
a = 1 'カウンター変数として
For m = 2 To 11 'B:K
For n = 1 To 54 '1:54
xa = Application.Small(x(), a)
j = Application.Match(xa, x(), 0)
d(n, m) = y(j)
a = a + 1
Next
Next
Range("B1:K54").Value = d()
MsgBox "Finish!"
End Sub
No.5
- 回答日時:
No.4です。
前回のコードで間違いがありました。
>myNum = Int((9999 - 1000) * Rnd + 1000)
を
>myNum = Int((9999 - 1000 + 1) * Rnd + 1000)
に変更してください。
そうしないと最大の「9999」が出現しないと思います。m(_ _)m
No.4
- 回答日時:
こんばんは!
横からお邪魔します。
重複なしに表示するようにしてみました。
Sub Sample1()
Dim c As Range, myNum As Long
Dim myFlg(1000 To 9999) As Boolean
For Each c In Range("B1:K54")
Do
myNum = Int((9999 - 1000) * Rnd + 1000)
Loop Until myFlg(myNum) = False
c = myNum
myFlg(myNum) = True
Next c
End Sub
こんな感じではどうでしょうか?m(_ _)m
No.3
- 回答日時:
かなり余分な処理があるので書き直しました。
以下のようになります。
------------------------------------
Option Explicit
Sub rnsuu01()
Dim row, col As Long
Const Ld = 1000
Const Ud = 9999
Randomize
Worksheets("sheet2").Range("B1:K54").ClearContents
'1行~54行まで繰り返し
For row = 1 To 54
'B列~K列まで繰り返し
For col = 2 To 8
'1000~9999の乱数を発生
Worksheets("sheet2").Cells(row, col) = Int(Rnd * (Ud - Ld + 1)) + Ld
Next
Next
End Sub
-------------------------------------------------
Worksheets("sheet2").Range("B1:K54").ClearContents
はなくても構いません。(B1:K54に乱数が設定されるので)
No.2
- 回答日時:
あなたが作成したマクロを画像ではなく、コピペして、補足として投稿して頂けますか。
投稿時、複数の空白が1つにまとめられるため、インデントがずれますが、それは気にする必要はありません。
そうすれば、私のほうで、正しく修正することができます。
画像のままでは、こちらでは修正できません。
tatsu99さんご親切にありがとうございます。以下がコードです。
返信が遅れすみません。
Sub rnsuu01()
Dim i As Long
Dim x()
Dim y()
Dim d
Const Ld = 1000
Const Ud = 9999
Const Pd = 342
ReDim x(1 To Ud - Ld + 1)
ReDim y(1 To Ud - Ld + 1)
ReDim d(1 To Ud - Ld + 1,1 To 1)
Randomize
No.1
- 回答日時:
Range("B1:K54")
は領域を示しています。
そこにd(i,1)に格納されている値を代入しようとするからエラーが発生しています。
表示するセルを、1個の値に付き1つに設定しないといけません。
例:B列に順に表示するなら、
cells(i,2)=d(i,1)
等に変更してみてください。
※「B1」から「K54」のように行や列を途中で変更したければ、もう一工夫必要です。
尚、乱数の発生アルゴリズムはチェックしていません。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Excel(エクセル) エクセルVBAでセルに表示されているとおりの数値を取得したい(時間の計算結果) 1 2022/03/30 17:52
- Visual Basic(VBA) 昨日、質問した件『VBA にて、条件付き書式で背景色を設定しているセルの範囲で、背景色付きのセルをカ 4 2022/04/07 14:39
- Visual Basic(VBA) Outlook VBAについて 1 2023/07/10 12:41
- 数学 確率について 8 2023/08/25 04:21
- Visual Basic(VBA) テーブルを配列に入れて、元のテーブルの行番号を取得したい 1 2022/08/16 20:15
- Visual Basic(VBA) ExcelのVBAコードについて教えてください。 1 2023/02/02 13:13
- Visual Basic(VBA) エクセルのマクロについて教えてください。 4 2023/03/02 08:40
- Excel(エクセル) 条件付き書式の色付きセルのカウント方法について 2 2022/10/21 14:51
- Excel(エクセル) ワードのマクロについて教えてください。 1 2023/03/11 13:50
- Excel(エクセル) 【マクロ】ボタンを押すごとに、A1セル、A2セル、A3セルに日付を入力 3 2023/01/25 00:12
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
マクロの「SaveAs」でエラーが...
-
VBA 別ブックからの転記の高速...
-
マクロ実行後に別シートの残像...
-
EXCELのSheet番号って変更でき...
-
VBA 空白行に転記する
-
【VBA】特定の条件でセルをコピー
-
Excel VBA オートフィルターで...
-
ExcelのVBマクロを、バックグラ...
-
VBAコードについて
-
100万件越えCSVから条件を満た...
-
グラフマクロで系列を変数にす...
-
VBAでのピボットテーブルの範囲...
-
VBAで、1つのエクセルで、2つの...
-
Count Ifのセルの範囲指定に変...
-
Excel2013で切り取り禁止
-
VBA 実行時エラー1004 rangeメ...
-
VBAのグラフに違うシートの...
-
【VBA】データを各シートに自動...
-
VBAで質問ですが、皆さんはどの...
-
アクセスからエクセルへ出力時...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
マクロの「SaveAs」でエラーが...
-
マクロ実行後に別シートの残像...
-
VBA 空白行に転記する
-
EXCELのSheet番号って変更でき...
-
VBA 別ブックからの転記の高速...
-
VBA別シートの最終行の次行へ転...
-
100万件越えCSVから条件を満た...
-
VBAで変数の数/変数名を動的に...
-
Unionでの他のシートの参照につ...
-
VBA 実行時エラー1004 rangeメ...
-
【VBA】特定の条件でセルをコピー
-
楽天RSSからエクセルVBAを使用...
-
【Excel VBA】自動メール送信の...
-
Changeイベントで複数セルへの...
-
Excel2013で切り取り禁止
-
Excel VBA オートフィルターで...
-
Count Ifのセルの範囲指定に変...
-
複数シートの複数列に入力され...
-
アクセスからエクセルへ出力時...
-
グラフマクロで系列を変数にす...
おすすめ情報
写真を追加しました。
Zincerさん御丁寧にありがとうございます。
アドバイスを受けやってみましたが、おっしゃる通りまだ工夫が必要なようで、思うようにはいきませんでした。
tatsu99さんご親切にありがとうございます。以下がコードです。
返信が遅れすみません。
Sub rnsuu01()
Dim i As Long
Dim x()
Dim y()
Dim d
Const Ld = 1000
Const Ud = 9999
Const Pd = 342
ReDim x(1 To Ud - Ld + 1)
ReDim y(1 To Ud - Ld + 1)
ReDim d(1 To Ud - Ld + 1,1 To 1)
Randomize
続き
For i = 1 To Ud - Ld + 1
x(i) = Rnd()
y(i) = i + Ld - 1
Next i
For i = 1 To Ud - Ld + 1
d(i,1)=y(Application.Match(Application.Small(x,i),x,0))
Next i
Worksheets("sheet2").Range("B1:K54").ClearContents
For i = 1 To Pd
Range("B1:K54").Value = RAND()*
Next i
End Sub
よろしくお願い致します。