vbaのDoloopの使い方がわかりません

質問

vbaでA1:A6に◯が4つ以上になるまでランダムで◯か×を入れて、4つ以上ならA1の隣のセルに行き同じ処理を繰り返す、を30回繰り返したいのですがどうすればいいですか？

簡単にいうと、A1:A6に◯が4つなければランダムに◯か×を入れる処理を4つ以上になるまでまで繰り返す。

A1:A6に◯が4つ以上なら隣のセル（B1）に移動し、B1:B6まで◯が4つなければ、、を30回（a~AE）繰り返したいです。

ちなみに◯か×かは繰り返す前にInt で1なら◯2なら×の乱数でやってます。

ちなみに今は
Dim i as long
for i=0to 29

do until range("a7").offst(0,i).value=>4
※a7はカウントイフでa1:a6の◯の数を数えてます
dim a as long
for a=1to 6

1なら◯2なら×を入れる処理

end if

intで乱数を決める

active cell.offset(1,0)
next a

range("a1").offset(0,1).select

loop

next i
endif

回答No.6

acidorange2

ご質問タイトルからは外れますが、
6個の中身を持った配列を用意して○と✕を決定しておき、A1〜A6にまとめて貼り付ける方法もあると思います。

下記のように乱数の偏りを防ぐ方法も解説があります。
これはデータが入ったセルでは並び替えに時間がかかりすぎるので配列で（メモリ上で）実行させるべきでしょう。
https://programming-place.net/ppp/contents/algorithm/other/002.html

参考まで。

回答No.5

imogasi

できれば数学のカテゴリに質問して、コード作成に取り掛かるべきでは？
一般に、普通に慣れている課題以外は、
慎重に周りの経験者などに教えてもらわないと、独りよがりのやり方になることが起りえる。
特に数学的・論理的なことや、特別なアルゴリズムを使いそうな場合はね。
ーー
コンピュータの乱数は、例えば、４回試行して（乱数を続けて出して）、出てくる数字が小さい数（指定。１－４までなど）の場合は、４回とも同じ数であることもある程度良く起こるである。
だからこの方法は使わないほうが良いと思う。
ーーー
小生も詳しくないが、各１列ずつについて、１－４のラン数を範囲の乱数を出し、３なら３個・３セルをその列のＡの数と決める。そしてＡの３個をどのセル（の行のセル、行範囲は１－６かな？）に割り振るか決める、とか思い付いた、がどうかな。

補足

そうなんだ！教えてくれてありがと！笑

回答No.4

kkkkkm

No2、No3の追加です。

イメージとして訂正モードでの作業に感じた(既存の○はそのまま残す)のですが、新規作成もありなら

Randomizeの前に

If MsgBox("新規作成ですか", vbQuestion + vbYesNo + vbDefaultButton2) = vbYes Then
Range("A1:AE6").ClearContents
End If

(新規作成だけならRange("A1:AE6").ClearContentsだけ)

回答No.3

kkkkkm

No.2の追加し忘れです

未入力セルを×で埋めたい場合は
Loop
Next
の間に

Loop←もとのLoop

For mRow = 1 To 6
If Cells(mRow, mCol).Value = "" Then
Cells(mRow, mCol).Value = "×"
End If
Next

Next←もとのNext

回答No.2

kkkkkm

'とりあえず質問の説明の通りにすると
Sub Test()
Dim mCol As Long, mRow As Long
Randomize
'（a~AE）繰り返したい
For mCol = Columns("A").Column To Columns("AE").Column
'◯が4つ以上なら隣のセルに移動(既に○が4つ以上あれば該当列は処理しない)
Do While WorksheetFunction.CountIf(Range(Cells(1, mCol), Cells(6, mCol)), "○") < 4
'◯が4つなければランダムに◯か×を入れる処理を「○」が4つになるまでまで繰り返す。
'○が4つになれば未入力があってもそのセルは放置(未入力セルの処理の説明がない)
mRow = WorksheetFunction.RandBetween(1, 6)
'1なら◯2なら×の乱数
If WorksheetFunction.RandBetween(1, 2) = 1 Then
Cells(mRow, mCol).Value = "○"
ElseIf Cells(mRow, mCol).Value <> "○" And Cells(mRow, mCol).Value = "" Then
'既に○があるセルには×を入れない
Cells(mRow, mCol).Value = "×"
End If
Loop
Next
End Sub

回答No.1

SI299792

30回なら A～ADですが。（とっちが正しいか解りませんが、31回への修正は簡単にできると思います）
１行に必ず○４つでいいですか❓
Option Explicit
'
Sub Macro1()
　　Dim Colu As Integer
　　Dim Rout As Integer
　　Dim Count As Integer
'
　　[A1:AD6] = "×"
'
　　For Colu = 1 To 30
　　　　Count = 0
'
　　　　Do While Count < 4
　　　　　　Rout = Rnd * 6 + 0.5
'
　　　　　　If Cells(Rout, Colu) = "×" Then
　　　　　　　　Cells(Rout, Colu) = "○"
　　　　　　　　Count = Count + 1
　　　　　　End If
　　　　Loop
　　Next Colu
End Sub