シフトの「出」と「休」を入れ替えたい

「出」が3回ある列の真ん中の「出」と「出」が１回の列の「休」を入れ替えたい。
下表の「出」が３回あるD列の真ん中の「出」Cells（7,4）と「出」が１回だけのE列Cells（7,５）を入れ替えてD列、E列とも「出」を２回にしたい。
同様にH列の「出」とG列の「休」も入れ替えたいのですが、どのような方法があるか教えてください。

No.2 ベストアンサー 回答者： tatsumaru77 回答日時： 2023/07/22 11:30

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

Option Explicit


Public Sub 出休入れ替え()
Dim ws As Worksheet '対象シート（アクティブシート）
Dim wrow As Long '作業行
Dim wcol As Long '作業列
Dim trg_row As Long '2番目の出の行
Dim exch_row As Long '入れ替え行
Dim exch_col 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
'出の数をカウントする。同時に2番目の出の行を記憶する
If ws.Cells(wrow, wcol).Value = "出" Then
dcount = dcount + 1
If dcount = 2 Then
trg_row = wrow
End If
End If
Next
'出の数が3なら、入れ替えを行う
If dcount = 3 Then
'入れ替え候補の列を探す
If find_exchange_col(ws, trg_row, exch_row, exch_col) = True Then
tmp = ws.Cells(trg_row, wcol).Value
ws.Cells(trg_row, wcol).Value = ws.Cells(exch_row, exch_col).Value
ws.Cells(exch_row, exch_col).Value = tmp
exch_count = exch_count + 1
End If
End If
Next
MsgBox ("完了　入れ替え件数=" & exch_count)
End Sub

'交換可能な列を探す
Private Function find_exchange_col(ByVal ws As Worksheet, ByVal trg_row As Long, ByRef exch_row As Long, ByRef exch_col As Long) As Boolean
find_exchange_col = False
Dim wrow As Long
Dim wcol As Long
Dim dcount As Long
'全列繰り返す
For wcol = 3 To 9
dcount = 0
'全行繰り返す（出の数をカウント）
For wrow = 4 To 14
If ws.Cells(wrow, wcol).Value = "出" Then
dcount = dcount + 1
End If
Next
'出の数が1なら
If dcount = 1 Then
'2番目の出の行が休なら、その行、列を交換可能行列として採用する
If ws.Cells(trg_row, wcol).Value = "休" Then
exch_row = trg_row
exch_col = wcol
find_exchange_col = True
Exit Function
End If
'2番目の出の行が休でないなら、その先頭の行から、休の値を探し、それを交換可能行列として採用する
For wrow = 4 To 14
If ws.Cells(wrow, wcol).Value = "休" Then
exch_row = wrow
exch_col = wcol
find_exchange_col = True
Exit Function
End If
Next
'それでも休がないなら（通常あり得ないが出が1個、以外が全部昼の場合等）、次の行を処理する
End If
Next
End Function

この回答へのお礼

ありがとうございます。Public SubとPrivate Functionで世界が広がり、値渡し（ByVal）、参照渡し（ByRef）など学ぶことが多いく、ありがたいです。完璧な内容にただただ脱帽です。

お礼日時：2023/07/22 20:35

No.1 回答者： tatsumaru77 回答日時： 2023/07/22 09:23

上記例で、

「下表の「出」が３回あるD列の真ん中の「出」Cells（7,4）と「出」が１回だけのE列Cells（7,５）を入れ替えてD列、E列とも「出」を２回にしたい。」
ということですが、もし、E列のCells（7,５）が「出」の場合は、どうしますか。（E列の出の数は１回です）

①E列は使えないので、他の列を探す。
②E列の「休」の行と入れ替える。（例 E列のCells（４,５）が「休」なので、そのセルの「休」と入れ替える）

のどちらでしょうか。

この回答へのお礼

ありがとうございます。②でお願いします。
私の知識では単純に入れ替える下記マクロから先に進めません...
Sub Sample()
Dim swap As Range
Set swap = Cells（7,4）
Cells（7,4）= Cells（7,５）
Cells（7,５）= swap
End Sub

お礼日時：2023/07/22 10:27