• ベストアンサー

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

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

質問者が選んだベストアンサー

  • ベストアンサー
  • n-jun
  • ベストアンサー率33% (959/2873)
回答No.1

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 一例まで。

alsdk
質問者

お礼

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

その他の回答 (3)

  • DOUGLAS_
  • ベストアンサー率74% (397/534)
回答No.4

#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

alsdk
質問者

お礼

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

  • DOUGLAS_
  • ベストアンサー率74% (397/534)
回答No.3

 ポイント は「8個になるまでの操作」かと存じますが、 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

  • mitarashi
  • ベストアンサー率59% (574/965)
回答No.2

#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

alsdk
質問者

お礼

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