同一列で連続した「出」を2コマ以上空けて「休」と入れ替えたい。

先週こちらで教えていただいたシフト振り分けの続きななります。
①9：00～13：00の間で、
Range("C5")とRange("C6")のように連続した場合、
時間の遅いRange("C6")を2コマ以上開けた14：00の「休」と入れ替えたい。
②14：00～19：00の間で、
Range("D10")とRange("D11")のように連続した場合、
時間の早いRange("D10")を2コマ以上開けた12：00の「休」と入れ替えたい。

No.1 ベストアンサー 回答者： tatsumaru77 回答日時： 2023/07/25 15:43

以下のマクロを標準モジュールに登録してください。

Option Explicit

Public Sub 出休入れ替え2()
Dim ws As Worksheet '対象シート（アクティブシート）
Dim wrow As Long '作業行
Dim wcol As Long '作業列
Dim drows(1) As Long '出の行の集まり
Dim trg_row As Long '交換用出の行
Dim exch_row As Long '入れ替え行
Dim dcount As Long '出の数
Dim tmp As String '一時保管
Dim exch_count As Long '入れ替え件数
exch_count = 0
Set ws = ActiveSheet
'全列繰り返し
For wcol = 3 To 9
dcount = 0
'全行繰り返し
For wrow = 4 To 14
'出の数をカウントする。
If ws.Cells(wrow, wcol).Value = "出" Then
If dcount < 2 Then
drows(dcount) = wrow
End If
dcount = dcount + 1
End If
Next
'出の数が2の場合
If dcount = 2 Then
'２つの出が所定時間の範囲内なら、２コマ以上開けた休の行を探す
If Check_Band(ws, wcol, drows, trg_row, exch_row) = True Then
tmp = ws.Cells(trg_row, wcol).Value
ws.Cells(trg_row, wcol).Value = ws.Cells(exch_row, wcol).Value
ws.Cells(exch_row, wcol).Value = tmp
exch_count = exch_count + 1
End If
End If
Next
MsgBox ("完了　入れ替え件数=" & exch_count)
End Sub

'2つの出が所定時間の範囲内かチェックし、範囲内であれば、交換対象の行を探す
Private Function Check_Band(ByVal ws As Worksheet, ByVal wcol, ByRef drows() As Long, ByRef trg_row As Long, ByRef exch_row As Long) As Boolean
Check_Band = False
exch_row = 0
Dim wrow As Long
'２つの出が連続していないなら終了
If drows(0) + 1 <> drows(1) Then Exit Function
'２つの出が9:00～13:00の範囲内の場合（2番目の出の行は連続しているのでチェックしない）
If drows(0) >= 4 And drows(0) < 8 Then
trg_row = drows(1)
'２コマ以上開けた休を探す(下方向へ検索)
For wrow = trg_row + 3 To 14
If ws.Cells(wrow, wcol).Value = "休" Then
exch_row = wrow
Exit For
End If
Next
End If
'２つの出が14:00～19:00の範囲内の場合（2番目の出の行は連続しているのでチェックしない）
If drows(0) >= 9 And drows(0) < 14 Then
trg_row = drows(0)
'２コマ以上開けた休を探す(上方向へ検索)
For wrow = trg_row - 3 To 4 Step -1
If ws.Cells(wrow, wcol).Value = "休" Then
exch_row = wrow
Exit For
End If
Next
End If
If exch_row > 0 Then Check_Band = True
End Function

この回答へのお礼

tatsumaru77さんのように言葉での説明が下記のようなコードに結びつくようになるには、わたしには何が足りないのだろう？おそらく経験と想像力でしょう。

exch_count = exch_count + 1
For wrow = trg_row + 3 To 14
For wrow = trg_row - 3 To 4 Step -1

感服しました。ありがとうございます。

お礼日時：2023/07/26 14:42