Excel VBA セルを指定個数ランダム選択

Excel VBA　セルを指定個数ランダム選択
A1からA30までのセルをランダムで8コ選んで値として"○"を入れる
ということをやりたいのですがどのようにすればよいでしょうか？

よろしくお願いします。

No.1 ベストアンサー 回答者： n-jun 回答日時： 2010/04/24 20:09

Sub try()

Dim i As Integer
Dim m As Integer

i = 1

Range("A1:A30").ClearContents

While i < 9
m = Int(Rnd() * 30) + 1

If Cells(m, 1).Value = "" Then
Cells(m, 1).Value = "○"
i = i + 1
End If

Wend

End Sub

一例まで。

この回答へのお礼

回答ありがとうございます
これに条件文等を付け加えれば色々できそうですね
早速使わせていただきます

お礼日時：2010/04/24 21:07

No.4 回答者： DOUGLAS_ 回答日時： 2010/04/24 23:22

#3 DOUGLAS_ です。

＞お好きな範囲にお好きな数だけどうぞ
と書きながら、
Range("A" & Int(セル.Rows.Count * Rnd) + 1).Value
はなかったですね。　　失礼いたしました。　　<(_ _)>

　矩形に限りますが
Sub Macro2()
　Dim セル As Range
　Dim 指定個数 As Integer
　Set セル = Range("A4:F11")
　セル.ClearContents
　指定個数 = 8
　Do
　　セル.Cells(Int(セル.Count * Rnd) + 1).Value = "○"
　Loop Until Application.CountA(セル) > 指定個数 - 1
　Set セル = Nothing
End Sub

この回答へのお礼

ご回答ありがとうございます
ランダムで選ぶループも実に色々なやり方があるのですね
一般化することで使い道が増えそうです
参考にさせて頂きます

お礼日時：2010/04/25 05:08

No.3 回答者： DOUGLAS_ 回答日時： 2010/04/24 22:50

　ポイント は「８個になるまでの操作」かと存じますが、

Sub Macro1()
　Range("A1:A30").ClearContents
　Do
　　Range("A" & Int(30 * Rnd) + 1).Value = "○"
　Loop Until Application.CountA(Range("A1:A30")) > 7
End Sub


　「指定個数」ということで、お好きな範囲にお好きな数だけどうぞ。
Sub Macro2()
　Dim セル As Range
　Dim 指定個数 As Integer
　Set セル = Range("A1:A30")
　セル.ClearContents
　指定個数 = 8
　Do
　　Range("A" & Int(セル.Rows.Count * Rnd) + 1).Value = "○"
　Loop Until Application.CountA(セル) > 指定個数 - 1
　Set セル = Nothing
End Su

No.2 回答者： mitarashi 回答日時： 2010/04/24 21:23

#1のご回答で十分なのですが、

>セルをランダムに8個選んで
というのを文字通りやってみました。ご参考まで。
Sub test()
Dim myRange As Range, targetRange As Range

Randomize (Now())
Set targetRange = Range("A1:A30")
With targetRange
.ClearContents
Do
If myRange Is Nothing Then
Set myRange = .Cells(Int(Rnd() * 30) + 1)
Else
Set myRange = Union(myRange, .Cells(Int(Rnd() * 30) + 1))
End If
Loop Until myRange.Cells.Count = 8
End With
myRange.Select
myRange.Value = "○"
End Sub

この回答へのお礼

ご回答ありがとうございます
8個選んだ後で値を入れる方法ですね
勉強が足りなくて何故選択したセルが重複しないか理解できていませんが
参考にさせて頂きます

お礼日時：2010/04/24 22:20