下記プログラムで、どうでしょう?
Sub test()
sr = Selection.Cells(1, 1).Row ' 範囲選択開始行番号
sc = Selection.Cells(1, 1).Column ' 範囲選択開始列番号
fr = Selection.Cells(Selection.Rows.Count, Selection.Columns.Count).Row ' 範囲選択終了行番号
fc = Selection.Cells(Selection.Rows.Count, Selection.Columns.Count).Column ' 範囲選択終了列番号
For i = sr To fr
For j = sc To fc
Randomize
n = Int(Rnd() * (3 - 1) + 1)' 1?3の間の数で乱数を発生させる(1)
Sheets("Sheet1").Cells(i, j) = Sheets("Sheet2").Cells(n, 1)' 乱数を使って、セルの値を取得し、転記(2)
Next
Next
End Sub
Sheet1が選択範囲の指定およびランダムに選んだセル値の転記先のシートになります。
Sheet2がランダムに選ばれる値が記入されているシートになります。上記プログラムでは、SheetA1?A3に入力された任意の文字列の中から選んでいます。
編集する場合は、シート名と(1)と(2)(ランダムに取得する値が入っている範囲をここで操作)を変えればよいです。
ご回答ありがとうございます。
後別プログラムについて少々お聞きしたいのですが
以下のようなマクロを作成したいと考えています。
まず別シートに以下のようなデータが設定されています。
http://oskuni.ichiya-boshi.net/aaa.htm
マクロを実行すると
本シートのデータを読み取り
http://oskuni.ichiya-boshi.net/aa.htm(本シート)
次々とデータを入力していきます。
本シートの上から順に行きますとまずはじめはりんご 赤色 で入っているので その横にあるE列の動作の所には
食べる、無視する、匂うのいずれかがランダムに次々と入力されてその次のりんご 青色でも次々と動作をしていけるようにしたいと考えています。
この場合ですがどのようなプログラムになるかお時間ありましたらお手数をおかけしますがよろしくお願いいたします。
別シートに入っている内容を、メインの選択部分へランダムに入れるプログラムです。例では、Sheet2のA1:A3にしてあります。
もし入れる箇所が固定であれば、「selection」の部分を「range("A1:A100")」のようにしてください。
Option Explicit Sub SetRndVal() Dim Datas() As Variant ' ランダム用のデータ場所定義(別シート) Const sDatasSheet As String = "Sheet2" Const sCol As String = "A" Const iLowerRow As Integer = 1 Const iUpperRow As Integer = 3 Dim rSetRng As Range Dim iUpperbound As Integer, iLowerbound As Integer Datas() = Range(sDatasSheet & "!" & sCol & iLowerRow _ & ":" & sCol & iUpperRow) iLowerbound = LBound(Datas) iUpperbound = UBound(Datas) Randomize ' 固定なら、selection→range("A1:A100")のように変更 For Each rSetRng In Selection rSetRng.Value = Datas(Int((iUpperbound - iLowerbound + 1) _ * Rnd + iLowerbound), 1) Next End Sub
ご回答ありがとうございます。
▽3
●
ardarim ●22ポイント ![]() |
このような感じのプログラム(VBA)になります。
Option Explicit Sub test() Dim MainSheet As Worksheet Dim SubSheet As Worksheet Dim MainRange As Range Dim SubRange As Range Dim cl As Range Dim r As Integer, c As Integer ' シート、セル範囲の指定 Set MainSheet = Worksheets("本シート") Set MainRange = MainSheet.Range("A1:A10") Set SubSheet = Worksheets("別シート") Set SubRange = SubSheet.Range("A1:A3") ' 乱数の初期化 Randomize ' 元になるセル範囲の行数、桁数を取得 r = SubRange.Rows.Count ' 行数 c = SubRange.Columns.Count ' 桁数 ' 値をセットする範囲のセル全部をループ指定 For Each cl In MainRange cl.Value = SubRange.Cells(Int(Rnd() * r) + 1, Int(Rnd() * c) + 1).Value Next cl End Sub
MainSheetには値をセットするシートを指定します。(ここでは"本シート"と言う名前のシートを指定しています)
SubSheetには元になる値が入力されているシートを指定します。(ここでは"別シート"と言う名前のシートを指定しています)
元になる別シートのセル範囲はSubRangeで設定しています。ここでは A1:A3 を指定していますが、A4:A7 や B7:B10 など任意の範囲に変更できます。
また値をセットするセル範囲はMainRangeで設定しています。ここでは A1:A100 で指定していますが、B1:B100 など任意の範囲に変更できます。
ご回答ありがとうございます。
面白そうなので、ハッシュで作ってみました。
Sub SetRndByKey() Const sTrgSheet As String = "Sheet1" Const iTrgColKey As Integer = 1 ' A Const iTrgColMethod As Integer = 5 ' E Const iTrgRowStart As Integer = 2 Const sKeySheet As String = "Sheet2" Const iColKey As Integer = 1 ' A Const iRowStart As Integer = 2 Dim oW2M As Object ' Word → Method (0:Count, 1:val1, 2:val2,・・・) Dim sAr() As Variant Dim sStrs() As Variant Dim sKey As String Dim lRowFrom As Long Dim lRow As Long Dim iLowerbound As Integer Dim iUpperbound As Integer ' ハッシュテーブルの作成 Set oW2M = CreateObject("Scripting.Dictionary") Worksheets(sKeySheet).Activate lRowFrom = iRowStart For lRow = iRowStart To Cells(65536, iColKey).End(xlUp).Row sKey = Cells(lRow, iColKey) & Cells(lRow, iColKey + 1) ' 次の行のキーが違っていたら、ハッシュへ追加 If sKey <> Cells(lRow + 1, iColKey) & Cells(lRow + 1, iColKey + 1) Then sAr() = Range(Cells(lRowFrom, iColKey + 2), Cells(lRow, iColKey + 2)) Call oW2M.Add(sKey, sAr) lRowFrom = lRow End If Next 'テーブルを元にシートへランダムに入れる Worksheets(sTrgSheet).Activate For lRow = iTrgRowStart To Cells(65536, iTrgColKey).End(xlUp).Row sKey = Cells(lRow, iColKey) & Cells(lRow, iColKey + 1) ' ハッシュテーブルから設定 If oW2M.exists(sKey) Then sStrs = oW2M(sKey) iLowerbound = LBound(sStrs) iUpperbound = UBound(sStrs) Cells(lRow, iTrgColMethod) = sStrs(Int((iUpperbound - iLowerbound + 1) _ * Rnd + iLowerbound), 1) End If Next End Sub
注意事項:Sheet1, Sheet2でやっています。場所は両方ともA2から実データスタート。
キーは、「みかん+青」のように二つを連結しています。例では色で決まっているようですが、文章から考えるとたぶん例の間違いかと。
ありがとうございます。