エクセルについて質問です。


指定した範囲に指定したセルの値をランダムに入力したいと考えています。

例)別シートのA1、A2、A3のセルに値を入力します。

そして本シート(プログラムを実行するメインのシート)A1~A100を選択して、別シートに入っているデータA1~A3の値をランダムに入力したいと考えています。

そういったプログラムは可能でしょうか?(別シートが無理な場合は本シートの中で全てのプログラムの動作が出来ればと考えています。)

別シートの値をA4~A7やB7~B10等に変えた場合や指定範囲をB1~B100等に変えた場合プログラムのどこを変えればいいのかも教えていただければ嬉しいです。(プログラム初心者で申し訳ございません。)

お手数をおかけしますがよろしくお願いいたします。


回答の条件
  • 1人2回まで
  • 登録:2008/07/22 23:20:07
  • 終了:2008/07/29 23:25:03

ベストアンサー

id:ardarim No.3

ardarim回答回数892ベストアンサー獲得回数1422008/07/23 00:45:15

ポイント22pt

このような感じのプログラム(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 など任意の範囲に変更できます。

id:aiomock

ご回答ありがとうございます。

2008/07/24 01:15:27

その他の回答(3件)

id:slapshock No.1

slapshock回答回数264ベストアンサー獲得回数152008/07/23 00:29:18

ポイント23pt

下記プログラムで、どうでしょう?

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)(ランダムに取得する値が入っている範囲をここで操作)を変えればよいです。

id:aiomock

ご回答ありがとうございます。

後別プログラムについて少々お聞きしたいのですが

以下のようなマクロを作成したいと考えています。

まず別シートに以下のようなデータが設定されています。

http://oskuni.ichiya-boshi.net/aaa.htm

マクロを実行すると

本シートのデータを読み取り

http://oskuni.ichiya-boshi.net/aa.htm(本シート)

次々とデータを入力していきます。

本シートの上から順に行きますとまずはじめはりんご 赤色 で入っているので その横にあるE列の動作の所には

食べる、無視する、匂うのいずれかがランダムに次々と入力されてその次のりんご 青色でも次々と動作をしていけるようにしたいと考えています。

この場合ですがどのようなプログラムになるかお時間ありましたらお手数をおかけしますがよろしくお願いいたします。

2008/07/23 13:15:23
id:airplant No.2

airplant回答回数220ベストアンサー獲得回数492008/07/23 00:42:06

ポイント23pt

別シートに入っている内容を、メインの選択部分へランダムに入れるプログラムです。例では、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
id:aiomock

ご回答ありがとうございます。

2008/07/24 01:15:00
id:ardarim No.3

ardarim回答回数892ベストアンサー獲得回数1422008/07/23 00:45:15ここでベストアンサー

ポイント22pt

このような感じのプログラム(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 など任意の範囲に変更できます。

id:aiomock

ご回答ありがとうございます。

2008/07/24 01:15:27
id:airplant No.4

airplant回答回数220ベストアンサー獲得回数492008/07/26 08:28:02

ポイント22pt

面白そうなので、ハッシュで作ってみました。

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から実データスタート。

キーは、「みかん+青」のように二つを連結しています。例では色で決まっているようですが、文章から考えるとたぶん例の間違いかと。

id:aiomock

ありがとうございます。

2008/07/27 21:32:52

コメントはまだありません

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません