🐦‍🔥⑧自動化の準備・出馬表の移動

Sub MyData保存() 'Sheets("MyData")モジュールからだとソート出来ない

Sheets("MyData").MyData日替色

With Sheets("出馬表")
    Uma = 16
    Uma位置

    .Activate
    .Range(Cells(5, 1), Cells(81, XJv)).Sort key1:=Cells(5, 4), Header:=xlNo '発送時刻（タイトルの下）'前日(土全 日重賞全 日他1部）土朝(土全 日重賞全）
    
    For YJv = 5 To 42
        YData = Sheets("MyData").Cells(1, 1)

        If .Cells(YJv, 1) = "End" Then
            Exit For
        End If
        
        If .Cells(YJv, 11) <> "" And .Cells(YJv, 12) <> "" And .Cells(YJv, 13) <> "" Then
        
            For XData = 1 To XJv
                 Sheets("MyData").Cells(YData, XData) = .Cells(YJv, XData)
            Next
            
            Sheets("MyData").Cells(1, 1) = Sheets("MyData").Cells(1, 1) + 1
        End If
    Next
    

End With

Sheets("MyData").MyData移動

End Sub

Sub 出馬からレース()
'yjv = 5 テスト用
With Sheets("レース") '-------------------------------コピー
    ExTop
    レースコピー
    
    .レースクリア
    
    
    .Cells(4, 6) = "単勝"
    .Cells(4, 7) = "馬名S"
    .Cells(4, 8) = "替 騎手"
   

    St1 = ""
    '------------------------------場'  StX = InStr(Jo, "回")
    St1 = "X回" & Mid(Cells(YJv, 4), 1, 2) & " " '9頭以下で必要
    
    '------------------------------頭数'
    St1 = St1 & Cells(YJv, 8) & "頭 "
    
    '------------------------------発送時間'
    St2 = Cells(YJv, 1)
    St2 = Mid(St2, 1, 2) & ":" & Mid(St2, 3, 2)
    St1 = St1 & "[" & Format(St2, "hh:mm") & "発走]"
    
    '------------------------------RNo'
    .Cells(1, 6) = St1 'レース等付き
    .Cells(2, 6) = "【" & Val(Cells(YJv, 5)) & "Ｒ】" 'レースNo
    
    '------------------------------Oz時間'
    .Cells(2, 5) = Cells(YJv, 12)
    
    '------------------------------コース'  StX = InStr(Cosu, "　")
    Cosu = Cells(YJv, 9)
    If Mid(Cosu, 2, 1) = "障" Then Cosu = "障" Else Cosu = Mid(Cosu, 1, 1)
    St1 = ""
    St1 = Replace(Cells(YJv, 6), "　", "") '全角スペース削除
    If St1 = "" Then St1 = "クラス" & Cells(YJv, 7) & "_" Else St1 = St1 & Cells(YJv, 7) & "_" 'レース名　無い時クラス
    St2 = Cells(YJv, 11)
    If St2 <> "良" Then St2 = "悪"
    .Cells(3, 5) = St2
    .Cells(3, 6) = St1 & "　" & Cosu & Cells(YJv, 10) & "_" & St2  '距離&状態追加
    
    '-------------------------------馬data
    For Uma = 1 To 18
        YR = Uma + 4
        Uma位置
        .Cells(YR, 6) = Cells(YJv, XJv + 1) 'oz
        St1 = Mid(Cells(YJv, XJv + 2), 1, 9) '馬名S
        If St1 <> "" Then
            .Cells(YR, 7) = St1
            .Cells(YR, 8) = Cells(YJv, XJv + 3) '替 騎手
        End If
    Next
    
End With
End Sub

Public XData#
Public YData#

Sub 右移動()
Uma = 19
Uma位置
A = XJv
YJv = 4

XJv = ActiveCell.Column + 1
If XJv < 21 Then XJv = 5

Do
    St1 = Cells(YJv, XJv)
    If St1 = "馬番" Then Exit Do
    If XJv > A Then
        XJv = XJv - 1
        Exit Do
    End If
    XJv = XJv + 1
Loop
Application.Goto Reference:=Cells(4, XJv), Scroll:=True

End Sub



Sub 左移動()
Uma = 19
Uma位置
A = XJv

YJv = 4
XJv = ActiveCell.Column - 1
If XJv < 21 Then XJv = 5

Do
    St1 = Cells(YJv, XJv)
    If St1 = "馬番" Then Exit Do
    If XJv < 5 Then
        XJv = XJv + 1
        Exit Do
    End If
    XJv = XJv - 1
Loop
Application.Goto Reference:=Cells(4, XJv), Scroll:=True

End Sub

Sub 出馬表馬毎タイトル() '出馬表　または　MyData　を開いて実行
For Uma = 1 To 18
    Uma位置
    Cells(4, XJv) = "馬番"
    Cells(4, XJv + 1) = "単勝"

    Cells(4, XJv + 2) = "馬名S"
    Cells(4, XJv + 3) = "替 騎手"
    Cells(4, XJv + 4) = "馬体重"
    Cells(4, XJv + 5) = "増減"
    'Cells(4, XJv + 6) = "SE予備"
    
    Cells(4, XJv + 7) = "日付"
    Cells(4, XJv + 8) = "着差"
    'Cells(4, XJv + 9) = "前走予備"
    
    Cells(4, XJv + 10) = "父"
    'Cells(4, XJv + 11) = "UM予備"
    
Next
End Sub

Sub MyData日替色()

Sheets("MyData").Activate
YData = Val(Cells(1, 1))
If YData < 5 Then
    YData = 5
    Cells(1, 1) = 5
End If

Range(Cells(YData, 1), Cells(YData, 5)).Select '時間 OZ時間

If Weekday(date) = 1 Then '日
    Selection.Interior.ColorIndex = 38 'ピンク
Else
    Selection.Interior.ColorIndex = 33 '水色
End If

End Sub
Sub MyData移動()

Sheets("MyData").Activate
If YData < 40 Then YData = 40
Application.Goto Reference:=Cells(YData - 36, 7), Scroll:=True 'False !!シートがActivateだけじゃなくシートプロジャーにないとダメ

End Sub

競馬でプログラムの作成
お疲れ様でした😎