エクセルのＶＢＡについて

エクセルのＶＢＡに関することです。
例えば、５０個のリストがあり、そこからランダムに１０個選び出す。そのランダムに選び出す手順を１０回繰り返す。ランダムに選んだ１０セットをシートに書き出すやり方を教えてください。よろしくお願いします。

リスト　　　　　　　　結果
　　　　　　　　　　　１セット　　　　２セット　　　　３セット　　　・・・・・・・　１０セット
りんご　　　　　　　みかん　　　　　りんご　　　　梨　　　　　　　　　　 　　キウイ　　
みかん　　　　　　　梨　　　　　　　バナナ　　　　パイナップル　　　　　　みかん
梨　　　　　　　　　　いちご　　　　みかん　　　　キウイ　　　　　　　　　　バナナ
バナナ　　　　　　　　：　　　　　　　　：　　　　　　　　：　　　　　　　　　　　　　：
パイナップル　　　　　　
キウイ
いちご
・
・
・
のような感じです。

No.3 ベストアンサー 回答者： nishi6 回答日時： 2014/07/21 02:53

＞ちなみにリストから選び出すとき、重複しないやり方はありますか？

無条件に選んでいるので重複することがありますね。選んだら消すようにして重複を避けるようにしました。ついでにマジックナンバー（数値）を変数にしました。


Sub getRand10()
　　Const Kaisuu = 10　　　　 '試行回数
　　Const pickNum = 10　　　　'抽出個数
　　
　　Dim iniList As Variant　　'リスト
　　Dim wkList As Variant　　 'リスト（作業用）
　　Dim ListCount As Integer 'リスト個数
　　
　　Dim r As Integer　　　　 '行カウンタ
　　Dim c As Integer　　　　 '列カウンタ
　　Dim idx As Integer　　　　'抽出するインデックス
　　
　　iniList = Range("A2:A51") 'シートから読み込み
　　ListCount = UBound(iniList)

　　Randomize　　'乱数の初期化
　　
　　For c = 1 To Kaisuu
　　　　r = 0
　　　　wkList = iniList　　'配列の初期化
　　　　Cells(1, c + 2) = c & "セット" '表題
　　　　
　　　　'抽出個数まで実行
　　　　While r < pickNum
　　　　　　idx = Int(Rnd() * ListCount + 1) '乱数
　　　　　　While wkList(idx, 1) = "" '消去データなら再試行
　　　　　　　　idx = Int(Rnd() * ListCount + 1)
　　　　　　Wend
　　　　　　
　　　　　　r = r + 1　　'出力
　　　　　　Cells(r + 1, c + 2) = wkList(idx, 1)
　　　　　　
　　　　　　wkList(idx, 1) = "" '抽出したら消す
　　　　Wend
　　Next
End Sub

この回答へのお礼

返事遅くなってすみません。回答ありがとうございます。おかげさまで課題ができました。

お礼日時：2014/07/25 18:24

No.2 回答者： tom04 回答日時： 2014/07/20 21:51

こんばんは！

安直な方法ですが、一例です。

Sheet1のA列1行目は項目行でデータは2行目以降にあるとします。
Sheet2に表示するようにしてみました。
標準モジュールです。

Sub Sample1()
Dim lastRow As Long, cnt As Long, wS As Worksheet
Set wS = Worksheets("Sheet2")
Application.ScreenUpdating = False
wS.Cells.Clear
With Worksheets("Sheet1")
.Range("B:C").Insert
lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
Range(.Cells(2, "B"), .Cells(lastRow, "B")).Formula = "=RAND()"
Range(.Cells(2, "C"), .Cells(lastRow, "C")).Formula = "=RANK(B2,B:B)"
For cnt = 1 To 10
.Calculate
.Range("A1").AutoFilter field:=3, Criteria1:="<=10"
wS.Cells(1, cnt) = cnt & "セット"
Range(.Cells(2, "A"), .Cells(lastRow, "A")).SpecialCells(xlCellTypeVisible).Copy wS.Cells(2, cnt)
Next cnt
.Range("B:C").Delete
.AutoFilterMode = False
End With
wS.Activate
wS.Columns.AutoFit
Application.ScreenUpdating = True
End Sub

こんな感じではどうでしょうか？m(_ _)m

No.1 回答者： nishi6 回答日時： 2014/07/20 21:00

こんな感じでしょうか。

シートのコードウィンドウに貼り付けます。（Excel2010）

A列の50個のデータから10個をC列以降に書き出しています。


Sub getRand10()
　　Dim List As Variant 'リスト
　　Dim r As Integer　　'行カウンタ
　　Dim c As Integer　　'列カウンタ
　　Dim idx As Integer '抽出するインデックス
　　
　　List = Range("A2:A51")

　　Randomize
　　
　　For c = 1 To 10
　　　　Cells(1, c + 2) = "リスト" & c
　　　　For r = 1 To 10
　　　　　　idx = Int(Rnd() * 50 + 1)
　　　　　　Cells(r + 1, c + 2) = List(idx, 1)
　　　　Next
　　Next
End Sub

この回答への補足

回答ありがとうございます。
ちなみにリストから選び出すとき、重複しないやり方はありますか？

補足日時：2014/07/21 01:24