[[20230419154427]]　『For next と　Do loop の組み合わせ』（初心者）　ページの最後に飛ぶ

『For next と　Do loop の組み合わせ』（初心者）

これまでにもいくつか質問させていただいています。
エクセルでシフト作成ができないかと思案しています。
以下のマクロを作成しました。

For next とDo loopを組み合わせたいのですが、next jのあとがForに続かず、Doの方にいってしまいます。

    Dim CntX As Integer
    Dim RndBetX As Integer
    Dim j As Integer

    CntX = WorksheetFunction.CountIf(Range(Cells(6, 9), Cells(16, 9)), "●")
    RndBetX = WorksheetFunction.RandBetween(6,16)

  For j = 9 To 15
  Do Until CntX = 2
    If Cells(RndBetX, j) = "" Then
      Cells(RndBetX, j) = "●"

      RndBetX = WorksheetFunction.RandBetween(6,16)
      CntX = WorksheetFunction.CountIf(Range(Cells(6, j), Cells(16, j)), "●")

   End If
  Loop
  Next j

意図としては、特定の技術を持った人を勤務させるのに人数を決めれるようにしようとしました。
RandBetween関数を用いてランダムに勤務する人を決めようと考えています。
●は勤務している人（夜勤）をあらわしています。
同一勤務で●が二人いれば、次の日に同一の操作をしたいと思っています。
別勤務がすでに入っている場合があるので、空白かどうかをIfで判別しています。

For next の中にdo loop入れることは不可能でしょうか？

＜使用 Excel：Microsoft365、使用 OS：MacOSX ＞

入ってるじゃん。
（じゃんじゃん） 2023/04/19(水) 16:14:29

CntX
を
初期化すれば良いのでは。。。＾＾；
多分ですが
よく見てませんので、外していましたら、お許しを
m(__)m
（隠居Z） 2023/04/19(水) 16:18:23

気になるところは、
「Cells(RndBetX, j) = ""」がFalseのときにRndBetXを更新しないので
同じセルを参照し続けて無限ループになっている点です。
（火災報知器） 2023/04/19(水) 16:21:40

  Dim CntX As Integer
  Dim RndBetX As Integer
  Dim j As Integer
  For j = 9 To 15
    Do
      CntX = WorksheetFunction.CountIf(Range(Cells(6, j), Cells(16, j)), "●")
      If CntX >= 2 Then Exit Do
        RndBetX = WorksheetFunction.RandBetween(6, 16)
        With Cells(RndBetX, j)
          If .Value = "" Then .Value = "●"
        End With
    Loop
  Next j

試していませんがこんな感じかな
（火災報知器） 2023/04/19(水) 16:29:20

みなさま返信ありがとうございます。

そして火災報知器様
こんな短時間で修正され、しかも思いの通りに動いてくれました！
すごいです。

本当にありがとうございました。
また、困ったらご質問させてください。
（初心者） 2023/04/19(水) 16:38:39

  Sub Sample()
    Dim var As Variant
    var = Array("●", "○", "△", "◇", "★", "休み")
    Dim i As Long
    For i = 0 To UBound(var)
      RndInput Range("I6:O16"), var(i), 2
    Next
  End Sub

  Sub RndInput(TargetRange As Range, ByVal CharStr As String, ByVal CharCnt As Long)
    Dim WF As WorksheetFunction
    Dim CntX As Long
    Dim RndBetX As Long
    Dim j As Long

    Set WF = WorksheetFunction
    For j = 1 To TargetRange.Columns.Count
      With TargetRange.Columns(j)
        CntX = WF.CountIf(.Cells, CharStr)
        Do While CntX < CharCnt
          '範囲内に空白セルがなければ終了
          If WF.CountBlank(.Cells) < 1 Then Exit Do
          RndBetX = WF.RandBetween(1, .Cells.Count)
          With .Cells(RndBetX)
            If .Value = "" Then
              .Value = CharStr
              CntX = CntX + 1
            End If
          End With
        Loop
      End With
    Next j
  End Sub

範囲内に空白セルが無い場合に無限ループ化するので修正したものを置いておきます。
（火災報知器） 2023/04/20(木) 16:56:49

コメント返信：

[ 一覧(最新更新順) ]

[[20230419154427]] 『For next と Do loop の組み合わせ』（初心者） ページの最後に飛ぶ

[[20230419154427]]　『For next と　Do loop の組み合わせ』（初心者）　ページの最後に飛ぶ