ｴｸｾﾙについて質問です｡

指定した範囲に指定したｾﾙの値をﾗﾝﾀﾞﾑに入力したいと考えています｡

例)別ｼｰﾄのA1､A2､A3のｾﾙに値を入力します｡

そして本ｼｰﾄ(ﾌﾟﾛｸﾞﾗﾑを実行するﾒｲﾝのｼｰﾄ)A1?A100を選択して､別ｼｰﾄに入っているﾃﾞｰﾀA1?A3の値をﾗﾝﾀﾞﾑに入力したいと考えています｡

そういったﾌﾟﾛｸﾞﾗﾑは可能でしょうか？(別ｼｰﾄが無理な場合は本ｼｰﾄの中で全てのﾌﾟﾛｸﾞﾗﾑの動作が出来ればと考えています｡)

別ｼｰﾄの値をA4?A7やB7?B10等に変えた場合や指定範囲をB1?B100等に変えた場合ﾌﾟﾛｸﾞﾗﾑのどこを変えればいいのかも教えていただければ嬉しいです｡(ﾌﾟﾛｸﾞﾗﾑ初心者で申し訳ございません｡)

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

下記ﾌﾟﾛｸﾞﾗﾑで､どうでしょう？

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)(ﾗﾝﾀﾞﾑに取得する値が入っている範囲をここで操作)を変えればよいです｡

別ｼｰﾄに入っている内容を､ﾒｲﾝの選択部分へﾗﾝﾀﾞﾑに入れるﾌﾟﾛｸﾞﾗﾑです｡例では､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

このような感じのﾌﾟﾛｸﾞﾗﾑ(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から実ﾃﾞｰﾀｽﾀｰﾄ｡

ｷｰは､｢みかん＋青｣のように二つを連結しています｡例では色で決まっているようですが､文章から考えるとたぶん例の間違いかと｡

(C)株式会社はてな