いつもお世話になっております、VBAで教えて頂きたいのですが

昨日教えて頂いたコードですが、私以外の人が使用することを考えると、日付けがあった方が分かりやすいと思いましたので、次の様に出来ないかと思います。私にはまだ、そこまでの実力はないので分かりません。宜しくお願い致します。
バラシシートと短冊シートがありますが、バラシシートのA列に日付けが入っています、バラシシートのS列データーが空欄の時に1ロットが終了で短冊シートのボックスを1つ飛ばして次ロットに行きますが、その時にバラシシートA列の日付けを短冊シートの始まるボックスの右下に（図の赤字の日付け505，506，507）といったようにしたいのですが、宜しくお願い致します。なお、図のバラシシートと短冊シートのデーターの中身はちがいます、こんな感じにとなっていますので、一致はしていません。

https://gyazo.com/1b1a6838142f5701e58680a1eaa043fe

Option Explicit
Dim sh1 As Worksheet 'バラシシート
Dim sh2 As Worksheet '短冊シート
Public Sub 短冊シート設定5()
Dim maxrow1 As Long
Dim maxrow2 As Long
Dim max_box As Long
Dim i As Long
Dim wrow As Long
Dim boxNo As Long
Dim seqNo As Long
Dim box_row As Long
Dim box_col As Long
Dim pv As String
Dim y As Long
Set sh1 = Worksheets("バラシ")
Set sh2 = Worksheets("短冊")
maxrow1 = sh1.Cells(Rows.Count, "S").End(xlUp).Row 'S列の最大行取得
If maxrow1 < 2 Then Exit Sub
maxrow2 = sh2.Cells(Rows.Count, "A").End(xlUp).Row 'A列の最大行取得
If (maxrow2 + 1) Mod 7 <> 0 Then
MsgBox ("マス番号の行が不正")
Exit Sub
End If
max_box = ((maxrow2 + 1) \ 7) * 3
'短冊シートのマスをクリア
For i = 1 To max_box
Call clear_box(i)
Next
'バラシシートを処理
boxNo = 1
seqNo = 0
pv = ""
For wrow = 2 To maxrow1
If sh1.Cells(wrow, "S").Value = "" Then
If seqNo > 0 Then
boxNo = boxNo + 2
seqNo = 0
pv = ""
End If
Else
seqNo = seqNo + 1
If (seqNo Mod 4) <> 1 And pv <> sh1.Cells(wrow, "S").Value Then
y = (seqNo - 1) \ 4
seqNo = (y + 1) * 4 + 1
End If
If seqNo > 24 Then
boxNo = boxNo + 1
seqNo = 1
End If
'マス番号とマス内番号に対応する位置を取得
Call get_pos_in_box(boxNo, seqNo, box_row, box_col)
'該当位置へS列データを設定
sh2.Cells(box_row, box_col).Value = sh1.Cells(wrow, "S").Value
sh2.Cells(box_row, box_col).Interior.Color = sh1.Cells(wrow, "S").Interior.Color
pv = sh1.Cells(wrow, "S").Value
End If
Next
MsgBox ("完了")
End Sub

'指定マスクリア
Private Sub clear_box(ByVal box_no As Long)
Dim box_row As Long
Dim box_col As Long
Dim i As Long
For i = 1 To 24
Call get_pos_in_box(box_no, i, box_row, box_col)
sh2.Cells(box_row, box_col).ClearContents
sh2.Cells(box_row, box_col).Interior.Pattern = xlNone
Next
End Sub
'指定マス内の指定位置取得
Private Sub get_pos_in_box(ByVal box_no As Long, ByVal seq_no As Long, ByRef box_row As Long, ByRef box_col As Long)
Dim x1 As Long
　 Dim x2 As Long
Dim y1 As Long
Dim y2 As Long

y1 = (box_no - 1) \ 3
y2 = 5 - ((seq_no - 1) \ 4)
box_row = y1 * 7 + 1 + y2
x1 = (box_no - 1) Mod 3
x2 = 3 - ((seq_no - 1) Mod 4)
box_col = x1 * 5 + 2 + x2
End Sub


tatsu....様、昨日はありがとうございました。段数変更して試しました。うまく動作出来ました。

No.2 ベストアンサー 回答者： tatsumaru77 回答日時： 2022/05/06 11:49

下記にアップしました。

前回アップしたものに、追記しています。
https://ideone.com/YnzCEP

この回答へのお礼

早い対応、ありがとうございます。
動作確認出来ました。
助かりました。ありがとうございました。

お礼日時：2022/05/06 12:41

No.1 回答者： tatsumaru77 回答日時： 2022/05/06 06:30

tatsumaru77です。

補足要求です。
１．枠内のデータは右下から左上に順に処理するということで間違いないでしょうか。

２．バラシシートのA列の日付は、0506になっていますが、
短冊シートの日付は506になっています。（先頭の0がとれています）
506で間違いないですか。それとも、0506が正しいのでしょうか。

３．短冊シートの日付は、赤色の文字になっていますが、
マクロで設定する際も、赤色の文字にしたいということでしょうか。
それとも、説明上、赤色の文字にしただけで、マクロで設定するのは、黒字で良いのでしょうか。

この回答へのお礼

いつもお世話になっております。
１.右下から左上であってます。
2.出来れば0506がいいのですが
3.赤字のが分かりやすいので赤字がいいのですが
宜しくお願い致します。

お礼日時：2022/05/06 08:59