このきなんのき
書き直した形跡があるが捏造ではなく素で間違えた。
将来が暗そうな理系じゃなくて文学とかやりたいから文系に移ろうかな…
注：正解はx=-21です。
冗談も大概にしてくれ…どう考えても生粋のマイラーであるマイティスピードが凱旋門賞へ行って勝てるわけないじゃないか！*1
ウルトラpre記法を使ってみた。結構使えるジャマイカ。
Sub Weekstart() Dim Money Dim GIWinning Dim Years Dim Weeks Dim Horses Money = Cells(4, 4).Value Years = Cells(5, 4).Value Weeks = Cells(5, 6).Value GIWinning = Cells(6, 4).Value Horses = Cells(7, 4).Value 'Weeksに1を足す Weeks = Weeks + 1 'Weeksが4の倍数+1であった場合は維持費20万×頭数を支出 Select Case Weeks Case 5 Money = Money - (Horses * 20) Case 9 Money = Money - (Horses * 20) Case 13 Money = Money - (Horses * 20) Case 17 Money = Money - (Horses * 20) Case 21 Money = Money - (Horses * 20) Case 25 Money = Money - (Horses * 20) Case 29 Money = Money - (Horses * 20) Case 33 Money = Money - (Horses * 20) Case 37 Money = Money - (Horses * 20) Case 41 Money = Money - (Horses * 20) Case 45 Money = Money - (Horses * 20) Case 49 Money = Money - (Horses * 20) Case 53 Money = Money - (Horses * 20) End Select 'Weeksが4の倍数+1であり、かつ難易度がLunaticである場合はさらに10万×頭数＋53週のみ500万（牧場維持費）を支出 If Worksheets("Sheet1").Range("F6") = "Lunatic" Then Select Case Weeks Case 5 Money = Money - (Horses * 10) Case 9 Money = Money - (Horses * 10) Case 13 Money = Money - (Horses * 10) Case 17 Money = Money - (Horses * 10) Case 21 Money = Money - (Horses * 10) Case 25 Money = Money - (Horses * 10) Case 29 Money = Money - (Horses * 10) Case 33 Money = Money - (Horses * 10) Case 37 Money = Money - (Horses * 10) Case 41 Money = Money - (Horses * 10) Case 45 Money = Money - (Horses * 10) Case 49 Money = Money - (Horses * 10) Case 53 Money = Money - (Horses * 10) - 500 End Select End If '値が52を超えていた場合は1に戻し、Yearsを1進める If Weeks > 52 Then Years = Years + 1 Weeks = 1 End If '種付した週になったら幼駒誕生 Dim Name As String Dim ans As Integer Dim PapaName As String Dim MamapapaName As String Dim PapaLine As String Dim Price As Long Dim Colls As Byte Dim Gender As Double If Weeks = Range("H10") Then 'リストを上から見ていき、埋まっていた場合は1行ずつずらす。入りきれない場合は評価額の半分で売却 If Worksheets("幼駒リスト").Range("A2") = "" Then Colls = 2 ElseIf Worksheets("幼駒リスト").Range("A3") = "" Then Colls = 3 ElseIf Worksheets("幼駒リスト").Range("A4") = "" Then Colls = 4 ElseIf Worksheets("幼駒リスト").Range("A5") = "" Then Colls = 5 ElseIf Worksheets("幼駒リスト").Range("A6") = "" Then Colls = 6 Else ans = MsgBox("幼駒が誕生しましたが、牧場が一杯なので売却しました。", vbOKOnly + vbInfomation, "売却") Money = Money + (Worksheets("FlagData").Range("C10") / 2) GoTo Rabel002 End If Gender = Rnd() ans = MsgBox("幼駒が誕生しました。名前をつけましょう。", vbOKOnly + vbInfomation, "幼駒誕生") PapaName = Worksheets("FlagData").Range("B10") Price = Worksheets("FlagData").Range("C10") + Int((2500 - -2500 + 1) * Rnd - 3000) MamapapaName = Worksheets("繁殖牝馬リスト").Range("D2") If Gender < 0.492 Then Worksheets("幼駒リスト").Cells(Colls, 7) = "牡" Else Worksheets("幼駒リスト").Cells(Colls, 7) = "牝" End If Rabel001: Name = InputBox("幼駒の名前を入力してください" & vbNewLine & Worksheets("幼駒リスト").Cells(Colls, 7) + "馬" & vbNewLine & "父：" + PapaName & vbNewLine & "母父：" + MamapapaName, "命名", "") If Name <> "" Then Worksheets("幼駒リスト").Cells(Colls, 1).Value = Name Else ans = MsgBox("名前は決めましょう。", vbOKOnly + vbCritical, "名無しの権兵衛はダメ！") GoTo Rabel001 End If Worksheets("幼駒リスト").Cells(Colls, 2) = Price Worksheets("幼駒リスト").Cells(Colls, 3) = Worksheets("FlagData").Range("D10") Worksheets("幼駒リスト").Cells(Colls, 4) = PapaName Worksheets("幼駒リスト").Cells(Colls, 5) = MamapapaName Worksheets("幼駒リスト").Cells(Colls, 6) = Worksheets("FlagData").Range("H10") Worksheets("幼駒リスト").Cells(Colls, 8) = Worksheets("FlagData").Range("E10") Worksheets("幼駒リスト").Cells(Colls, 9) = Worksheets("FlagData").Range("F10") Worksheets("幼駒リスト").Cells(Colls, 10) = Worksheets("FlagData").Range("G10") '種付した週、種付した牡馬の情報を消し、種付可能な状態にする。 Rabel002: Worksheets("Sheet1").Activate Worksheets("FlagData").Range("A10:H10") = "" End If If Weeks = Range("H11") Then 'リストを上から見ていき、埋まっていた場合は1行ずつずらす。入りきれない場合は評価額の半分で売却 If Worksheets("幼駒リスト").Range("A2") = "" Then Colls = 2 ElseIf Worksheets("幼駒リスト").Range("A3") = "" Then Colls = 3 ElseIf Worksheets("幼駒リスト").Range("A4") = "" Then Colls = 4 ElseIf Worksheets("幼駒リスト").Range("A5") = "" Then Colls = 5 ElseIf Worksheets("幼駒リスト").Range("A6") = "" Then Colls = 6 Else ans = MsgBox("幼駒が誕生しましたが、牧場が一杯なので売却しました。", vbOKOnly + vbInfomation, "売却") Money = Money + (Worksheets("FlagData").Range("C11") / 2) GoTo Rabel004 End If Gender = Rnd() ans = MsgBox("幼駒が誕生しました。名前をつけましょう。", vbOKOnly + vbInfomation, "幼駒誕生") PapaName = Worksheets("FlagData").Range("B11") Price = Worksheets("FlagData").Range("C11") + Int((2500 - -2500 + 1) * Rnd - 3000) MamapapaName = Worksheets("繁殖牝馬リスト").Range("D3") If Gender < 0.492 Then Worksheets("幼駒リスト").Cells(Colls, 7) = "牡" Else Worksheets("幼駒リスト").Cells(Colls, 7) = "牝" End If Rabel003: Name = InputBox("幼駒の名前を入力してください" & vbNewLine & Worksheets("幼駒リスト").Cells(Colls, 7) + "馬" & vbNewLine & "父：" + PapaName & vbNewLine & "母父：" + MamapapaName, "命名", "") If Name <> "" Then Worksheets("幼駒リスト").Cells(Colls, 1).Value = Name Else ans = MsgBox("名前は決めましょう。", vbOKOnly + vbCritical, "名無しの権兵衛はダメ！") GoTo Rabel003 End If Worksheets("幼駒リスト").Cells(Colls, 2) = Price Worksheets("幼駒リスト").Cells(Colls, 3) = Worksheets("FlagData").Range("D11") Worksheets("幼駒リスト").Cells(Colls, 4) = PapaName Worksheets("幼駒リスト").Cells(Colls, 5) = MamapapaName Worksheets("幼駒リスト").Cells(Colls, 6) = Worksheets("FlagData").Range("H11") Worksheets("幼駒リスト").Cells(Colls, 8) = Worksheets("FlagData").Range("E11") Worksheets("幼駒リスト").Cells(Colls, 9) = Worksheets("FlagData").Range("F11") Worksheets("幼駒リスト").Cells(Colls, 10) = Worksheets("FlagData").Range("G11") '種付した週、種付した牡馬の情報を消し、種付可能な状態にする。 Rabel004: Worksheets("Sheet1").Activate Worksheets("FlagData").Range("A11:H11") = "" End If '資金が100億円突破＝税金取り立て←ダビスタか If Money >= 1000000 Then ans = MsgBox("突然ですが税務署です。" & vbNewLine & "確定申告は済みましたか、税金はきちんと納めましょう", vbOKOnly + vbCritical, "税金はきちんと納めましょう") Money = Money - (Money / 2) End If '新しい値をシートに書き込む Worksheets("Sheet1").Activate Worksheets("FlagData").Cells(3, 1).Value = Money Worksheets("FlagData").Cells(4, 1).Value = Years Worksheets("FlagData").Cells(5, 1).Value = Weeks '資金がマイナス＝死亡 If Money < 0 Then ans = MsgBox("資金が底をつきました。これ以上馬主を続けられません。", vbOKOnly + vbCritical, "ゲームオーバー") Call GameStart1 End If End Sub
