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                  'box_noに対応する列ブロックインデックス
                                    'box_no=1,4,7  =>0
                                    'box_no=2,5,8  =>1
                                    'box_no=3,6,9  =>2
 
    Dim x2 As Long                  'seq_noに対応する列ブロック内インデックス
                                    'seq_no=1,5,9  =>3
                                    'box_no=2,6,10 =>2
                                    'box_no=3,7,11 =>1
                                    'box_no=4,8,12 =>0
 
    Dim y1 As Long                  'box_noに対応する行ブロックインデックス
                                    'box_no=1～3  =>0
                                    'box_no=4～6  =>1
                                    'box_no=7～10 =>2
 
    Dim y2 As Long                  'seq_noに対応する行ブロック内インデックス
                                    'seq_no=1～4   =>5
                                    'seq_no=5～8   =>4
                                    'seq_no=9～12  =>3
                                    'seq_no=13～16 =>2
                                    'seq_no=17～20 =>1
                                    'seq_no=21～24 =>0
 
    y1 = (box_no - 1) \ 3           'y1はbox_noから1を引いた結果を3で割った値（余りは切り捨て）
    y2 = 5 - ((seq_no - 1) \ 4)     'y2は5-(seq_noから1を引いた結果を4で割った値（余りは切り捨て）)・・・ここを変更
    box_row = y1 * 7 + 1 + y2       '指定マスの行はy1を7倍して、1加算し、更にy2を加算した値
    x1 = (box_no - 1) Mod 3         'x1はbox_noから1を引いた結果を3で割った余り
    x2 = 3 - ((seq_no - 1) Mod 4)   'x2は3-(seq_noから1を引いた結果を4で割った余り)・・・・ここを変更
    box_col = x1 * 5 + 2 + x2       '指定マスの列はx1を5倍して、2加算し、更にx2を加算した値
End Sub
 
 
 
 
 
 

T3B0aW9uIEV4cGxpY2l0CgpEaW0gc2gxIEFzIFdvcmtzaGVldCAgICAn44OQ44Op44K344K344O844OICkRpbSBzaDIgQXMgV29ya3NoZWV0ICAgICfnn63lhorjgrfjg7zjg4gKUHVibGljIFN1YiDnn63lhorjgrfjg7zjg4joqK3lrpo1KCkKICAgIERpbSBtYXhyb3cxIEFzIExvbmcKICAgIERpbSBtYXhyb3cyIEFzIExvbmcKICAgIERpbSBtYXhfYm94IEFzIExvbmcKICAgIERpbSBpIEFzIExvbmcKICAgIERpbSB3cm93IEFzIExvbmcKICAgIERpbSBib3hObyBBcyBMb25nCiAgICBEaW0gc2VxTm8gQXMgTG9uZwogICAgRGltIGJveF9yb3cgQXMgTG9uZwogICAgRGltIGJveF9jb2wgQXMgTG9uZwogICAgRGltIHB2IEFzIFN0cmluZwogICAgRGltIHkgQXMgTG9uZwogICAgU2V0IHNoMSA9IFdvcmtzaGVldHMoIuODkOODqeOCtyIpCiAgICBTZXQgc2gyID0gV29ya3NoZWV0cygi55+t5YaKIikKICAgIG1heHJvdzEgPSBzaDEuQ2VsbHMoUm93cy5jb3VudCwgIlMiKS5FbmQoeGxVcCkucm93ICAgJ1PliJfjga7mnIDlpKfooYzlj5blvpcKICAgIElmIG1heHJvdzEgPCAyIFRoZW4gRXhpdCBTdWIKICAgIG1heHJvdzIgPSBzaDIuQ2VsbHMoUm93cy5jb3VudCwgIkEiKS5FbmQoeGxVcCkucm93ICAnQeWIl+OBruacgOWkp+ihjOWPluW+lwogICAgSWYgKG1heHJvdzIgKyAxKSBNb2QgNyA8PiAwIFRoZW4KICAgICAgICBNc2dCb3ggKCLjg57jgrnnlarlj7fjga7ooYzjgYzkuI3mraMiKQogICAgICAgIEV4aXQgU3ViCiAgICBFbmQgSWYKICAgIG1heF9ib3ggPSAoKG1heHJvdzIgKyAxKSBcIDcpICogMwogICAgJ+efreWGiuOCt+ODvOODiOOBruODnuOCueOCkuOCr+ODquOCogogICAgRm9yIGkgPSAxIFRvIG1heF9ib3gKICAgICAgICBDYWxsIGNsZWFyX2JveChpKQogICAgTmV4dAogICAgJ+ODkOODqeOCt+OCt+ODvOODiOOCkuWHpueQhgogICAgYm94Tm8gPSAxCiAgICBzZXFObyA9IDAKICAgIHB2ID0gIiIKICAgIEZvciB3cm93ID0gMiBUbyBtYXhyb3cxCiAgICAgICAgSWYgc2gxLkNlbGxzKHdyb3csICJTIikuVmFsdWUgPSAiIiBUaGVuCiAgICAgICAgICAgIElmIHNlcU5vID4gMCBUaGVuCiAgICAgICAgICAgICAgICBib3hObyA9IGJveE5vICsgMgogICAgICAgICAgICAgICAgc2VxTm8gPSAwCiAgICAgICAgICAgICAgICBwdiA9ICIiCiAgICAgICAgICAgIEVuZCBJZgogICAgICAgIEVsc2UKICAgICAgICAgICAgc2VxTm8gPSBzZXFObyArIDEKICAgICAgICAgICAgSWYgKHNlcU5vIE1vZCA0KSA8PiAxIEFuZCBwdiA8PiBzaDEuQ2VsbHMod3JvdywgIlMiKS5WYWx1ZSBUaGVuCiAgICAgICAgICAgICAgICB5ID0gKHNlcU5vIC0gMSkgXCA0CiAgICAgICAgICAgICAgICBzZXFObyA9ICh5ICsgMSkgKiA0ICsgMQogICAgICAgICAgICBFbmQgSWYKICAgICAgICAgICAgSWYgc2VxTm8gPiAyNCBUaGVuCiAgICAgICAgICAgICAgICBib3hObyA9IGJveE5vICsgMQogICAgICAgICAgICAgICAgc2VxTm8gPSAxCiAgICAgICAgICAgIEVuZCBJZgogICAgICAgICAgICAn44Oe44K555Wq5Y+344Go44Oe44K55YaF55Wq5Y+344Gr5a++5b+c44GZ44KL5L2N572u44KS5Y+W5b6XCiAgICAgICAgICAgIENhbGwgZ2V0X3Bvc19pbl9ib3goYm94Tm8sIHNlcU5vLCBib3hfcm93LCBib3hfY29sKQogICAgICAgICAgICAn6Kmy5b2T5L2N572u44G4U+WIl+ODh+ODvOOCv+OCkuioreWumgogICAgICAgICAgICBzaDIuQ2VsbHMoYm94X3JvdywgYm94X2NvbCkuVmFsdWUgPSBzaDEuQ2VsbHMod3JvdywgIlMiKS5WYWx1ZQogICAgICAgICAgICBzaDIuQ2VsbHMoYm94X3JvdywgYm94X2NvbCkuSW50ZXJpb3IuQ29sb3IgPSBzaDEuQ2VsbHMod3JvdywgIlMiKS5JbnRlcmlvci5Db2xvcgogICAgICAgICAgICBwdiA9IHNoMS5DZWxscyh3cm93LCAiUyIpLlZhbHVlCiAgICAgICAgRW5kIElmCiAgICBOZXh0CiAgICBNc2dCb3ggKCLlrozkuoYiKQpFbmQgU3ViCgon5oyH5a6a44Oe44K544Kv44Oq44KiClByaXZhdGUgU3ViIGNsZWFyX2JveChCeVZhbCBib3hfbm8gQXMgTG9uZykKICAgIERpbSBib3hfcm93IEFzIExvbmcKICAgIERpbSBib3hfY29sIEFzIExvbmcKICAgIERpbSBpIEFzIExvbmcKICAgIEZvciBpID0gMSBUbyAyNAogICAgICAgIENhbGwgZ2V0X3Bvc19pbl9ib3goYm94X25vLCBpLCBib3hfcm93LCBib3hfY29sKQogICAgICAgIHNoMi5DZWxscyhib3hfcm93LCBib3hfY29sKS5DbGVhckNvbnRlbnRzCiAgICAgICAgc2gyLkNlbGxzKGJveF9yb3csIGJveF9jb2wpLkludGVyaW9yLlBhdHRlcm4gPSB4bE5vbmUKICAgIE5leHQKRW5kIFN1Ygon5oyH5a6a44Oe44K55YaF44Gu5oyH5a6a5L2N572u5Y+W5b6XClByaXZhdGUgU3ViIGdldF9wb3NfaW5fYm94KEJ5VmFsIGJveF9ubyBBcyBMb25nLCBCeVZhbCBzZXFfbm8gQXMgTG9uZywgQnlSZWYgYm94X3JvdyBBcyBMb25nLCBCeVJlZiBib3hfY29sIEFzIExvbmcpCiAgICBEaW0geDEgQXMgTG9uZyAgICAgICAgICAgICAgICAgICdib3hfbm/jgavlr77lv5zjgZnjgovliJfjg5bjg63jg4Pjgq/jgqTjg7Pjg4fjg4Pjgq/jgrkKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgJ2JveF9ubz0xLDQsNyAgPT4wCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICdib3hfbm89Miw1LDggID0+MQogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAnYm94X25vPTMsNiw5ICA9PjIKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAgICBEaW0geDIgQXMgTG9uZyAgICAgICAgICAgICAgICAgICdzZXFfbm/jgavlr77lv5zjgZnjgovliJfjg5bjg63jg4Pjgq/lhoXjgqTjg7Pjg4fjg4Pjgq/jgrkKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgJ3NlcV9ubz0xLDUsOSAgPT4zCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICdib3hfbm89Miw2LDEwID0+MgogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAnYm94X25vPTMsNywxMSA9PjEKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgJ2JveF9ubz00LDgsMTIgPT4wCiAgICAKICAgIERpbSB5MSBBcyBMb25nICAgICAgICAgICAgICAgICAgJ2JveF9ub+OBq+WvvuW/nOOBmeOCi+ihjOODluODreODg+OCr+OCpOODs+ODh+ODg+OCr+OCuQogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAnYm94X25vPTHvvZ4zICA9PjAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgJ2JveF9ubz00772eNiAgPT4xCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICdib3hfbm89N++9njEwID0+MgogICAgCiAgICBEaW0geTIgQXMgTG9uZyAgICAgICAgICAgICAgICAgICdzZXFfbm/jgavlr77lv5zjgZnjgovooYzjg5bjg63jg4Pjgq/lhoXjgqTjg7Pjg4fjg4Pjgq/jgrkKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgJ3NlcV9ubz0x772eNCAgID0+NQogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAnc2VxX25vPTXvvZ44ICAgPT40CiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICdzZXFfbm89Oe+9njEyICA9PjMKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgJ3NlcV9ubz0xM++9njE2ID0+MgogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAnc2VxX25vPTE3772eMjAgPT4xCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICdzZXFfbm89MjHvvZ4yNCA9PjAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAgICB5MSA9IChib3hfbm8gLSAxKSBcIDMgICAgICAgICAgICd5MeOBr2JveF9ub+OBi+OCiTHjgpLlvJXjgYTjgZ/ntZDmnpzjgpIz44Gn5Ymy44Gj44Gf5YCk77yI5L2Z44KK44Gv5YiH44KK5o2o44Gm77yJCiAgICB5MiA9IDUgLSAoKHNlcV9ubyAtIDEpIFwgNCkgICAgICd5MuOBrzUtKHNlcV9ub+OBi+OCiTHjgpLlvJXjgYTjgZ/ntZDmnpzjgpI044Gn5Ymy44Gj44Gf5YCk77yI5L2Z44KK44Gv5YiH44KK5o2o44Gm77yJKeODu+ODu+ODu+OBk+OBk+OCkuWkieabtAogICAgYm94X3JvdyA9IHkxICogNyArIDEgKyB5MiAgICAgICAn5oyH5a6a44Oe44K544Gu6KGM44GveTHjgpI35YCN44GX44Gm44CBMeWKoOeul+OBl+OAgeabtOOBq3ky44KS5Yqg566X44GX44Gf5YCkCiAgICB4MSA9IChib3hfbm8gLSAxKSBNb2QgMyAgICAgICAgICd4MeOBr2JveF9ub+OBi+OCiTHjgpLlvJXjgYTjgZ/ntZDmnpzjgpIz44Gn5Ymy44Gj44Gf5L2Z44KKCiAgICB4MiA9IDMgLSAoKHNlcV9ubyAtIDEpIE1vZCA0KSAgICd4MuOBrzMtKHNlcV9ub+OBi+OCiTHjgpLlvJXjgYTjgZ/ntZDmnpzjgpI044Gn5Ymy44Gj44Gf5L2Z44KKKeODu+ODu+ODu+ODu+OBk+OBk+OCkuWkieabtAogICAgYm94X2NvbCA9IHgxICogNSArIDIgKyB4MiAgICAgICAn5oyH5a6a44Oe44K544Gu5YiX44GveDHjgpI15YCN44GX44Gm44CBMuWKoOeul+OBl+OAgeabtOOBq3gy44KS5Yqg566X44GX44Gf5YCkCkVuZCBTdWIKCgoKCgo=