Option Explicit
Public Sub 新規リーグ作成()
Dim i As Byte
Dim Pi As String
Dim Bi As String
For i = 0 To 11
Sheets("リーグ情報").Activate
Pi = Cells(3 + i, 4) & "_投手"
Bi = Cells(3 + i, 4) & "_野手"
Call シート内容クリア(Bi)
Call 野手作成(Bi, True)
Call 野手成長(Bi)
Call シート内容クリア(Pi)
Call 投手作成(Pi, True)
Call 投手成長(Pi)
Next i
MsgBox ("リーグ作成が完了しました。")
End Sub
Public Sub 能力指数非表示()
Dim i As Byte
For i = 1 To 46
If i = 1 Then
Cells(3, 1).Select
Selection.EntireRow.Hidden = True
Cells(4, 1).Select
Selection.EntireRow.Hidden = True
Else
Cells((i * 3), 1).Select
Selection.EntireRow.Hidden = True
Cells((i * 3) + 1, 1).Select
Selection.EntireRow.Hidden = True
End If
Next i
Cells(2, 1).Select
End Sub
Public Sub 能力指数表示()
Dim i As Byte
For i = 1 To 46
If i = 1 Then
Cells(3, 1).Select
Selection.EntireRow.Hidden = False
Cells(4, 1).Select
Selection.EntireRow.Hidden = False
Else
Cells((i * 3), 1).Select
Selection.EntireRow.Hidden = False
Cells((i * 3) + 1, 1).Select
Selection.EntireRow.Hidden = False
End If
Next i
Cells(2, 1).Select
End Sub
Public Sub 開幕準備()
Dim i As Byte 'ループ
Dim PBi As String 'チーム
Dim OK_Order As String
MsgBox ("開幕オーダーを作成しています。一旦画面は消えますが、終了後再表示されますので、しばらくお待ちください。")
Application.WindowState = xlMinimized
For i = 0 To 11
'不要な選手を削除
Sheets("リーグ情報").Activate
PBi = Cells(3 + i, 4) & "_野手"
Sheets(PBi).Activate
'野手処理
Call 退団選手削除(PBi)
Call 野手移動
Call 新人移動(PBi)
Sheets("リーグ情報").Activate
PBi = Cells(3 + i, 4) & "_投手"
Sheets(PBi).Activate
'投手処理
Call 退団選手削除(PBi)
Call 投手陣並び替え
Call 新人移動(PBi)
Next i
For i = 0 To 11
Sheets("リーグ情報").Activate
PBi = Cells(3 + i, 4)
Call 開幕(PBi, i)
Next i
Application.WindowState = xlNormal
'投手の投法 Ro、LoをR、Lに変換
Range("B:B,V:V").Select
Selection.Replace What:="o", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
MsgBox ("開幕準備が出来ました。テキストファイルを作成してベストプレープロ野球で読み込ませてください")
End Sub
Public Function 開幕(PBi As String, Ti As Byte)
'定数
Const WriteSheet As String = "開幕用" '書きこみシート
Const SerBat As Byte = 24 '野手条件位置
Const SerPit As Byte = 16 '投手条件位置
'変数
Dim L As Byte '0：野手ループ 1：投手ループ
Dim i As Integer 'ショートループ
Dim j As Integer '書きこみループ
Dim WriteFrg As Boolean '書き込みフラグ
Dim VarTouroku As Variant 'ベスプレ登録条件
Dim ReadSheet As String '読み込むシート名
Dim VarAtai As Variant '移動用の項目保管先
Dim Low As Single '読み込み行
Dim Col As Byte '読み込み列
Dim WLow As Integer '書きこみ行 先発：22 中継ぎ：28 抑え：32 各チーム開始位置35行間隔
Dim WCol As Integer '書きこみ列 セリーグ：0 パリーグ：20
'野手と投手ループ処理
For L = 0 To 1
'変数初期設定
Col = 2
Low = 2
j = 0
'セリーグとパリーグでは 書きこむ列が違う為
If Ti <= 5 Then
WLow = Ti * 35 + 4
If L = 1 Then
WCol = 11
Else
WCol = 19
End If
Else
WLow = (Ti - 6) * 35 + 4
If L = 1 Then
WCol = 31
Else
WCol = 39
End If
End If
If L = 1 Then
WLow = WLow + 19
End If
Do Until 41 - j = 0
'書きこみを初期化
WriteFrg = False
If L = 0 Then
'読み込むシート名の設定
ReadSheet = PBi & "_野手"
'読み込むシート参照
Sheets(ReadSheet).Activate
Col = 23
'野手は34+5名なので…
If j = 38 Then
j = 40
End If
'野手登録条件にマッチングするかチェック
If Len(Sheets(ReadSheet).Cells(Low, SerBat)) > 0 Then
VarTouroku = Sheets(ReadSheet).Cells(Low, SerBat)
If VarTouroku = "１軍" Then
WriteFrg = True
Else
WriteFrg = False
End If
End If
Else
'読み込むシート名の設定
ReadSheet = PBi & "_投手"
'読み込むシート参照
Sheets(ReadSheet).Activate
Col = 15
'投手登録条件にマッチングするかチェック
If Len(Sheets(ReadSheet).Cells(Low, SerPit)) > 0 Then
VarTouroku = Sheets(ReadSheet).Cells(Low, SerPit)
Select Case VarTouroku
Case "先発"
WriteFrg = True
Case "中継ぎ"
WriteFrg = True
Case "抑え"
WriteFrg = True
Case Else
WriteFrg = False
End Select
End If
End If
'ベスプレ登録条件に満たした場合
If WriteFrg = True Then
'書きこみシート参照
Sheets(WriteSheet).Activate
'各項目の移動
i = 0
Do Until Col - i = 0
'開幕用シートに書き込み
If Col - i < 2 Or Col - i > 5 Then
'読み込むシート参照
Sheets(ReadSheet).Activate
VarAtai = Sheets(ReadSheet).Cells(Low, Col - i)
'書きこみシート参照
Sheets(WriteSheet).Activate
'名前の書きこみ
If Col - i < 2 Then
If Ti < 6 Then
Sheets(WriteSheet).Cells(WLow, 1) = VarAtai
Else
Sheets(WriteSheet).Cells(WLow, 21) = VarAtai
End If
Else
Sheets(WriteSheet).Cells(WLow, WCol - i) = VarAtai
End If
End If
i = i + 1
Loop
WLow = WLow + 1
End If
Low = Low + 3
j = j + 1
Loop
Next L
Sheets(WriteSheet).Activate
End Function
Public Sub テキストファイル作成()
Dim strdir As String
Dim BytLen As Integer '書込む文字数
Dim LimLen As Integer '調整用文字数
Dim Strlen As String '書込み文字
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim Low As Byte
Dim Col As Byte
strdir = strdir & "TeamData.txt"
Open strdir For Output As #1
For k = 0 To 11
Sheets("リーグ情報").Activate
'チーム情報書き込み
'ヘッダー作成
Print #1, ";--------------------------------------------------------------------"
Print #1, "; チーム名 略称 記 球場"
Low = 3 + k
Col = 1
BytLen = 0
Strlen = " "
LimLen = 0
'２行目作成
For i = 1 To 4
Col = Col + 1
'文字数取得
'BytLen = (Len(Cells(Low, Col))) + BytLen
If i = 3 And Len(Cells(Low, Col)) = 2 Then
Strlen = Strlen & StrConv(Cells(Low, Col), vbNarrow)
BytLen = (Len(Cells(Low, Col))) + BytLen - 1
Else
Strlen = Strlen & Cells(Low, Col)
BytLen = (Len(Cells(Low, Col))) + BytLen
End If
Select Case i
Case 1
LimLen = LimLen + (12 / i)
Case 2
LimLen = LimLen + (12 / i)
Case 3
LimLen = LimLen + (12 / i) - 1
End Select
If i <> 4 Then
If BytLen <= LimLen Then
Do Until BytLen = LimLen
Strlen = Strlen & " "
BytLen = BytLen + 1
Loop
End If
Else
Strlen = RTrim(Strlen)
End If
Select Case i
Case 1
Strlen = Strlen & " "
Case 2
Strlen = Strlen & " "
End Select
Next i
Print #1, Strlen
Print #1, ""
Print #1, "; UNIFORM SYMBOL BGM"
'２行目作成
Col = 6
BytLen = 0
Strlen = " "
LimLen = 0
Sheets("リーグ情報").Activate
For i = 1 To 4
Col = Col + 1
'文字数取得
BytLen = (Len(Cells(Low, Col))) + BytLen
Strlen = Strlen & Cells(Low, Col)
LimLen = LimLen + 13
If i <> 4 Then
If BytLen <= LimLen Then
Do Until BytLen = LimLen
Strlen = Strlen & " "
BytLen = BytLen + 1
Loop
End If
Else
Strlen = RTrim(Strlen)
End If
Next i
Print #1, Strlen
Print #1, ""
Print #1, "; 監督 タ 投 選 打 バ エ 盗 Ａ 抑"
Strlen = " "
BytLen = 0
LimLen = 14
Col = Col + 1
For i = 0 To 9
If i = 0 Then
Col = 6
ElseIf i = 1 Then
Col = 11
End If
LimLen = LimLen + 3
'文字数取得
If i = 0 Then
BytLen = ((Len(Cells(Low, Col)) * 2)) + BytLen
Else
BytLen = (Len(Cells(Low, Col))) + BytLen
End If
If i > 0 And Len(Cells(Low, Col)) = 1 Then
Strlen = Strlen & " " & Cells(Low, Col)
BytLen = BytLen + 1
Else
Strlen = Strlen & Cells(Low, Col)
End If
If i <> 9 Then
If BytLen <= LimLen Then
Do Until BytLen >= LimLen
Strlen = Strlen & " "
BytLen = BytLen + 1
Loop
End If
Else
Strlen = RTrim(Strlen)
End If
Col = Col + 1
Next i
Print #1, Strlen
Print #1, ""
Print #1, "; 野手 席 タ C 1 2 3 S O 肩 走 眼 実 ス 巧 長 信 左 指数"
'野手データ書き込み
Sheets("開幕用").Activate
If k < 6 Then
Low = 3 + (k * 35)
Else
Low = 3 + ((k - 6) * 35)
End If
For j = 0 To 15
If j < 8 Then
Strlen = j + 2 & " "
Else
Strlen = "- "
End If
If k < 6 Then
Col = 1
Else
Col = 21
End If
Low = Low + 1
LimLen = 14
BytLen = 0
For i = 0 To 18
If i = 0 Then
BytLen = ((Len(Cells(Low, Col)) * 2))
Strlen = Strlen & Cells(Low, Col)
ElseIf Len(Cells(Low, Col)) > 0 Then
BytLen = (Len(Cells(Low, Col))) + BytLen
Strlen = Strlen & Cells(Low, Col)
Else
Strlen = Strlen & "-"
BytLen = BytLen + 1
End If
If i >= 3 And i <= 7 Then
LimLen = LimLen + 2
ElseIf i = 15 And Cells(Low, Col + 1) <> 0 Then
LimLen = LimLen + 2
ElseIf i = 16 And Cells(Low, Col) <> 0 And Cells(Low, Col + 1) <> 0 Then
LimLen = LimLen + 3
ElseIf i = 16 And Cells(Low, Col) <> 0 And Cells(Low, Col + 1) = 0 Then
LimLen = LimLen + 4
ElseIf i = 16 And Cells(Low, Col) = 0 And Cells(Low, Col + 1) <> 0 Then
LimLen = LimLen + 2
ElseIf i = 17 And Cells(Low, Col) <> 0 Then
LimLen = LimLen + 4
Else
LimLen = LimLen + 3
End If
If i <> 18 Then
If BytLen <= LimLen Then
Do Until BytLen >= LimLen
Strlen = Strlen & " "
BytLen = BytLen + 1
Loop
End If
Else
Strlen = RTrim(Strlen)
End If
Col = Col + 1
Next i
Print #1, Strlen
Next j
'投手データ書き込み
Print #1, ""
Print #1, "; 投手 投 タ 球速 切 制 安 質 術 ス 回 指数"
If k < 6 Then
Low = 22 + (k * 35)
Else
Low = 22 + ((k - 6) * 35)
End If
For j = 0 To 11
If k < 6 Then
Col = 1
Else
Col = 21
End If
Low = Low + 1
BytLen = 0
Strlen = ""
LimLen = 0
For i = 0 To 11
If i = 11 Then
Strlen = Strlen & "200"
Exit For
End If
If i = 0 Then
BytLen = ((Len(Cells(Low, Col)) * 2))
Strlen = "P " & Cells(Low, Col)
Else
Strlen = Strlen & Cells(Low, Col)
BytLen = BytLen + Len(Cells(Low, Col))
End If
Select Case i
Case 0
LimLen = 17 + LimLen
Case 1, 4 To 9, 11
LimLen = 3 + LimLen
Case 2, 10
LimLen = 4 + LimLen
Case 3
LimLen = 5 + LimLen
End Select
If BytLen <= LimLen Then
Do Until BytLen >= LimLen
Strlen = Strlen & " "
BytLen = BytLen + 1
Loop
End If
Col = Col + 1
Next i
Print #1, Strlen
Next j
If k <> 11 Then
Print #1, ""
End If
Next k
Close #1
MsgBox ("チームデータのテキストファイルを作成しました。作成先：" & strdir)
Sheets("リーグ情報").Activate
End Sub
Public Sub ストーブリーグ()
Dim i As Byte
Dim j As Byte
Dim L As Byte
Dim Low As Byte
Dim Col As Byte
Dim SN As String
Dim Point As Byte
Dim BT As Boolean
Dim PBi As String
Dim PBJ As String
For i = 0 To 11
Sheets("リーグ情報").Activate
PBi = Cells(3 + i, 4)
Call 年齢加算(PBi)
PBJ = PBi & "_野手"
Call 野手作成(PBJ, False)
Call 野手成長(PBJ)
PBJ = PBi & "_投手"
Call 投手作成(PBJ, False)
Call 投手成長(PBJ)
Next i
MsgBox ("キャンプが終了しました。")
End Sub
'サイコロ
Public Function Saikoro(Optional ByVal Mentai As Integer = 100)
Randomize
Saikoro = Int((Rnd * Mentai) + 1)
End Function
'名前書き込み
Public Sub Get_Name(WriteSheet As String, Optional Newleague As Boolean = False, Optional Pitcher As Boolean = False)
Const NameList As String = "名前リスト"
Dim i As Integer 'ループ回数
Dim j As Byte '名前リスト 日本人と外国人の列を入れる
Dim ID As Integer '名前のID番号
Dim Low As Integer '行
Dim Col As Integer '列
Dim ii As Integer '書き始め 新人は１２０行目からスタート
Dim EndLow As Integer '野手ループ回数
Dim SensyuSu As Long '選手名を入れる変数
Dim BytB As Byte '野手の状況取得用
Dim BytP As Byte '投手の状況取得用
Sheets(WriteSheet).Activate
'名前の書き始め位置の指定
Col = 1
Low = 2
'変数初期化 BytB BytPは選手の状態判別列
BytB = 23
BytP = 15
'一から始める＝true 新人だけつくる＝false
If Newleague = True Then
ii = 0
Else
'ピッチャーと野手では新人の書き込む位置が違う為 行指定
If Pitcher = False Then
ii = 102
Else
ii = 108
End If
End If
'EndLowは最終行の指定
If Pitcher = False Then
EndLow = 130
Else
EndLow = 136
End If
'選手名を名前リストから取得し書き込む
For i = ii To EndLow Step 3 '選手数 34名で３行つかっているので（34＊3）回名前が必要、Stepは３行使っているから
'外国人名を書き込む場所か判定
If Pitcher = True Then
If i >= 107 And i <= 121 Then
j = 4 '外国人名が日本人名の4列先にあるので変数割り当て BからFで４列後
End If
Else
If i >= 101 And i <= 115 Then
j = 4 '外国人名が日本人名の4列先にあるので変数割り当て BからFで４列後
End If
End If
'外国人の名前の登録者総数が書いてあるところ
If j = 4 Then
SensyuSu = Sheets(NameList).Range("E2")
Else
'日本人の名前の登録者総数が書いてあるところ
SensyuSu = Sheets(NameList).Range("A2")
End If
'さいころ（乱数）で選手名番号取得 ここでは選手名総数の中から選ぶ為、引数に選手名総数を使っている。
ID = Saikoro(SensyuSu)
If Sheets(WriteSheet).Cells(Low + i, Col + BytB) <> "１軍" And Sheets(WriteSheet).Cells(Low + i, Col + BytP) <> "先発" _
And Sheets(WriteSheet).Cells(Low + i, Col + BytP) <> "中継ぎ" And Sheets(WriteSheet).Cells(Low + i, Col + BytP) <> "抑え" Then
'登録選手名の書き込み
Sheets(WriteSheet).Cells(Low + i, Col) = Sheets(NameList).Cells(ID + 2, Col + 1 + j)
'登録選手の登録名番号書き込み
Sheets(WriteSheet).Cells(Low + i + 1, Col) = Sheets(NameList).Cells(ID + 2, Col + j)
End If
'再度 基本の日本人に戻す。現役と新人に挟まれた場所に外国人がいる為
j = 0
Next i
End Sub
Public Function Get_SeityoType(Atai As Byte, i As Integer, Hosei As Byte, Syubetu As String) As String
Select Case Atai
Case Is <= 25
Get_SeityoType = "早熟"
Select Case i
Case 0
Hosei = Sheets("設定表").Cells(30, 9)
If Syubetu = "外人" Then
Hosei = Hosei + 30
End If
Case 1
Hosei = Sheets("設定表").Cells(30, 10)
If Syubetu = "外人" Then
Hosei = Hosei + 10
End If
Case Else
Hosei = Sheets("設定表").Cells(30, 11)
If Syubetu = "外人" Then
Hosei = Hosei + 60
End If
End Select
Case Is <= 65
Get_SeityoType = "普通"
Select Case i
Case 0
Hosei = Sheets("設定表").Cells(30, 12)
If Syubetu = "外人" Then
Hosei = Hosei + 30
End If
Case 1
Hosei = Sheets("設定表").Cells(30, 13)
If Syubetu = "外人" Then
Hosei = Hosei + 10
End If
Case Else
Hosei = Sheets("設定表").Cells(30, 14)
If Syubetu = "外人" Then
Hosei = Hosei + 60
End If
End Select
Case Is <= 85
Get_SeityoType = "晩成"
Select Case i
Case 0
Hosei = Sheets("設定表").Cells(30, 15)
If Syubetu = "外人" Then
Hosei = Hosei + 30
End If
Case 1
Hosei = Sheets("設定表").Cells(30, 16)
If Syubetu = "外人" Then
Hosei = Hosei + 10
End If
Case Else
Hosei = Sheets("設定表").Cells(30, 17)
If Syubetu = "外人" Then
Hosei = Hosei + 60
End If
End Select
Case Is <= 95
Get_SeityoType = "安定"
Select Case i
Case 0
Hosei = Sheets("設定表").Cells(30, 18)
If Syubetu = "外人" Then
Hosei = Hosei + 30
End If
Case 1
Hosei = Sheets("設定表").Cells(30, 19)
If Syubetu = "外人" Then
Hosei = Hosei + 10
End If
Case Else
Hosei = Sheets("設定表").Cells(30, 20)
If Syubetu = "外人" Then
Hosei = Hosei + 60
End If
End Select
Case Else
Get_SeityoType = "持続"
Select Case i
Case 0
Hosei = Sheets("設定表").Cells(30, 21)
If Syubetu = "外人" Then
Hosei = Hosei + 30
End If
Case 1
Hosei = Sheets("設定表").Cells(30, 22)
If Syubetu = "外人" Then
Hosei = Hosei + 10
End If
Case Else
Hosei = Sheets("設定表").Cells(30, 23)
If Syubetu = "外人" Then
Hosei = Hosei + 60
End If
End Select
End Select
End Function
Public Function Get_Nouryoku(Atai As Integer, Optional BytHosei As Byte = 0) As String
If Atai < 240 Then
Atai = Atai + BytHosei
End If
Select Case Atai
Case Is >= Sheets("設定表").Range("B19")
Get_Nouryoku = Sheets("設定表").Range("E19")
Case Is >= Sheets("設定表").Range("B20")
Get_Nouryoku = Sheets("設定表").Range("E20")
Case Is >= Sheets("設定表").Range("B21")
Get_Nouryoku = Sheets("設定表").Range("E21")
Case Is >= Sheets("設定表").Range("B22")
Get_Nouryoku = Sheets("設定表").Range("E22")
Case Is >= Sheets("設定表").Range("B23")
Get_Nouryoku = Sheets("設定表").Range("E23")
Case Else
Get_Nouryoku = Sheets("設定表").Range("E24")
End Select
End Function
Public Function NouryokuUp(mode As String, ByRef UpNoryoku As Integer, Optional ByRef GetFrg = False, Optional ByVal Avipoint As Byte = 0) As Integer
Dim ch As Byte
Select Case mode
Case "S"
NouryokuUp = Sheets("設定表").Range("T33")
Case "A"
NouryokuUp = Sheets("設定表").Range("T34")
Case "B"
NouryokuUp = Sheets("設定表").Range("T35")
Case "C"
NouryokuUp = Sheets("設定表").Range("T36")
Case "D"
NouryokuUp = Sheets("設定表").Range("T37")
Case "E"
NouryokuUp = Sheets("設定表").Range("T38")
Case Else
NouryokuUp = Sheets("設定表").Range("T39")
End Select
NouryokuUp = NouryokuUp - (5 + Avipoint)
'確率リミット
If (NouryokuUp + Avipoint) >= 95 Then
NouryokuUp = 95
End If
If (NouryokuUp + Avipoint) <= 5 Then
NouryokuUp = 5
End If
'能力アップ連荘判定（最終アップ）
Do While NouryokuUp > Saikoro(100)
'クリティカル判定
If UpNoryoku <= 245 Then
ch = Saikoro(10)
Select Case ch
Case 3, 7
UpNoryoku = UpNoryoku + 1 + (Saikoro(2))
Case Else
UpNoryoku = UpNoryoku + 1
End Select
End If
Loop
End Function
Public Function NouryokuDown(mode As String, ByRef DownNoryoku As Integer, Optional ByRef GetFrg = False, Optional ByVal Avipoint As Integer = 0) As Integer
Dim ch As Byte
If DownNoryoku <= 10 Then
Exit Function
End If
Select Case mode
Case "S"
NouryokuDown = Sheets("設定表").Range("U33")
Case "A"
NouryokuDown = Sheets("設定表").Range("U34")
Case "B"
NouryokuDown = Sheets("設定表").Range("U35")
Case "C"
NouryokuDown = Sheets("設定表").Range("U36")
Case "D"
NouryokuDown = Sheets("設定表").Range("U37")
Case "E"
NouryokuDown = Sheets("設定表").Range("U38")
Case Else
NouryokuDown = Sheets("設定表").Range("U39")
End Select
NouryokuDown = NouryokuDown + (5 - Avipoint)
If (NouryokuDown + Avipoint) >= 95 Then
NouryokuDown = 95
End If
If (NouryokuDown + Avipoint) <= 5 Then
NouryokuDown = 5
End If
'能力ダウン連荘判定（最終アップ）
Do While NouryokuDown > Saikoro(100)
'引退フラグ判定とクリティカル判定
If DownNoryoku > 10 Then
ch = Saikoro(10)
Select Case ch
Case 3, 7
DownNoryoku = DownNoryoku - 1 - (Saikoro(2))
Case Else
DownNoryoku = DownNoryoku - 1
End Select
Else
GetFrg = True
End If
Loop
End Function
Public Function 年齢加算(PBi As String)
Dim j As Byte
Dim i As Byte
Dim ii As Byte
Dim k As Byte
Dim ID As Integer
Dim Low As Byte
Dim Col As Byte
Dim colcol As Byte
Dim PBJ As String
For j = 0 To 1
Low = 0
Col = 2
If j = 0 Then
PBJ = PBi & "_野手"
Sheets(PBJ).Activate
ii = 39
colcol = 24 + 3
Else
PBJ = PBi & "_投手"
Sheets(PBJ).Activate
ii = 41
colcol = 16 + 3
End If
For i = 0 To ii
'年齢加算
Low = Low + 3
If Cells(Low, Col) > 1 Then
Cells(Low, Col) = Cells(Low, Col) + 1
End If
Next i
Next j
End Function
Public Function 退団選手削除(ActiveSheetName As String)
Dim WName As Variant
Dim i As Byte
Dim Low As Byte
Dim Col As Byte
WName = Right(ActiveSheetName, 2)
If WName = "野手" Then
Col = 28
Else
Col = 20
End If
Low = 2
For Low = 2 To 139 Step 3
i = 1
'退団選手を削除
If Cells(Low, Col - 4) = "退団" _
Or Cells(Low, Col - 4) = "外人" _
Or Cells(Low, Col - 4) = "新人" Then
'各項目の削除
Do Until Col - i = 0
Cells(Low, Col - i) = ""
Cells(Low + 1, Col - i) = ""
Cells(Low + 2, Col - i) = ""
i = i + 1
Loop
End If
Next Low
End Function
Public Function 新人移動(ActiveSheetName As String)
Dim WName As Variant
Dim i As Byte
Dim j As Byte '新人数5名
Dim Low As Byte
Dim Col As Byte
Dim movlow As Byte
WName = Right(ActiveSheetName, 2)
'初期設定
If WName = "野手" Then
Col = 28
Low = 119
Else
Col = 20
Low = 125
End If
For j = 1 To 5
If WName = "野手" Then
'新人の1軍選手の移動
If Cells(Low, Col - 4) = "１軍" Then
movlow = 2
Else
'新人の2軍への移動
movlow = 50
End If
Else
'新人の１軍への移動
If Cells(Low, Col - 4) = "先発" Then
movlow = 2
ElseIf Cells(Low, Col - 4) = "中継ぎ" Then
movlow = 20
ElseIf Cells(Low, Col - 4) = "抑え" Then
movlow = 32
Else
movlow = 38
End If
End If
If WName = "野手" Then
'空いている行を探す
Do Until Cells(movlow, Col - 4) = ""
movlow = movlow + 3
Loop
'各項目の移動
If movlow < 102 Then
Call 選手移動(movlow, Low, Col)
End If
Else
'空いている行を探す
Do Until Cells(movlow, Col - 4) = ""
movlow = movlow + 3
Loop
'各項目の移動
If movlow < 108 Then
Call 選手移動(movlow, Low, Col)
End If
End If
Low = Low + 3
Next j
End Function
Public Function 選手移動(movlow As Byte, Low As Byte, Col As Byte)
Dim i As Integer
'各項目の移動
i = 0
Do Until Col - i = 0
'3行分移動
Cells(movlow, Col - i) = Cells(Low, Col - i)
Cells(Low, Col - i) = ""
Cells(movlow + 1, Col - i) = Cells(Low + 1, Col - i)
Cells(Low + 1, Col - i) = ""
Cells(movlow + 2, Col - i) = Cells(Low + 2, Col - i)
Cells(Low + 2, Col - i) = ""
i = i + 1
Loop
End Function
'Newleague True:新規球団作成 False:２年目以降の新人・外人作成
Public Sub 投手作成(SName As String, Optional Newleague As Boolean = True)
Dim i As Integer 'ループ回数
Dim j As Byte '投手の作成開始：新規=0 ２年目以降=36
Dim y As Byte '野手数
Dim Low As Byte 'ワークシートの行
Dim Col As Byte 'ワークシートの列
Dim PStyle As String '投法
Dim Hosei(2) As Byte '成長タイプにおける初期補正値0:(心),1:(技),2:(体)
Dim Point As Byte '一時格納変数(成長の補正ポイント：特徴のポイント)
Dim Jinsyu As String '人種
Dim Bk_Sisu(1) As Byte '能力値決定時一時保管用
Worksheets(SName).Activate
'選手名を作成
'選手名を作成
If Newleague = True Then
Call Get_Name(SName, True, True)
j = 0
Else
Call Get_Name(SName, False, True)
j = 36
End If
For y = j To 45
'変数初期設定
Low = 3
Low = Low + (y * 3) '選手数分だけ行をずらす。
Col = 3
i = 0
Point = 0
'名前部分を選択
Cells(Low - 1, 1).Select
Selection.Font.ColorIndex = 0
'外人対策
If Newleague = False And Cells(Low, 2) > 1 Then
Else
'今季年齢決定
Select Case y
Case Is <= 35 '既存選手
Cells(Low, Col - 1) = 18 + (Saikoro(17)) + 1
Case Is >= 41 '新人
Cells(Low, Col - 1) = 18 + ((Saikoro(4) * 2) - 2) + 1
Case Else '外人
Cells(Low, Col - 1) = 25 + (Saikoro(9)) + 1
End Select
'初期年齢設定
Cells(Low - 1, Col - 1) = 16
'基本能力値決定（項目分だけ作成）:i=0心：i=12回復
For i = 0 To 12
'球速から回復までは（１～128
'球速と切れと球質とスタミナと回復は２回の内どちらか良い方を選択
If i = 5 Or i = 6 Or i = 9 Or i = 11 Or i = 12 Then
Bk_Sisu(0) = Saikoro(128)
Bk_Sisu(1) = Saikoro(128)
If Bk_Sisu(0) > Bk_Sisu(1) Then
Cells(Low, Col + i) = Bk_Sisu(0)
Else
Cells(Low, Col + i) = Bk_Sisu(1)
End If
ElseIf i = 3 Or i = 4 Then
Cells(Low, Col + i) = Saikoro(100)
Else
Cells(Low, Col + i) = Saikoro(128)
End If
'選手の能力成長補正ポイントを作成・書き込み
If Col + i > 7 Then
Cells(Low + 1, Col + i) = Saikoro(9)
End If
Next i
'人種判定:行により決定：外人は外人枠から移動しない為
If y > 36 And y < 42 Then
Jinsyu = "外人"
Else
Jinsyu = "日本人"
End If
'成長タイプ確定
For i = 0 To 2
Cells(Low - 1, Col + i) = Get_SeityoType(Cells(Low, Col + i).Value, i, Point, Jinsyu)
'成長タイプにおける初期補正値獲得
Hosei(i) = Point
Next i
'変数の値変更
Col = Col + 3
'投法確定
Cells(Low - 1, Col) = Get_Touho(Cells(Low, Col))
PStyle = Right(Cells(Low - 1, Col), 1)
'変数の値変更
Col = Col + 1
'タイプ確定
Cells(Low - 1, Col) = Get_PType(Cells(Low, Col))
'変数の値変更
Col = Col + 1
'球速確定
Cells(Low - 1, Col) = Get_Kyusoku(Cells(Low, Col), PStyle)
'変数の値変更
Col = Col + 1
'切れ確定
Cells(Low, Col) = (Cells(Low, Col) + Hosei(1))
Cells(Low - 1, Col) = Get_Nouryoku(Cells(Low, Col))
'変数の値変更
Col = Col + 1
'制球確定
Cells(Low, Col) = (Cells(Low, Col) + Hosei(1))
Cells(Low - 1, Col) = Get_Nouryoku(Cells(Low, Col))
'変数の値変更
Col = Col + 1
'安定確定
Cells(Low, Col) = (Cells(Low, Col) + Hosei(0))
Cells(Low - 1, Col) = Get_Nouryoku(Cells(Low, Col))
'変数の値変更
Col = Col + 1
'球質確定
Cells(Low, Col) = (Cells(Low, Col) + Hosei(2))
Cells(Low - 1, Col) = Get_Nouryoku(Cells(Low, Col))
'変数の値変更
Col = Col + 1
'技術確定
Cells(Low, Col) = (Cells(Low, Col) + Hosei(0))
Cells(Low - 1, Col) = Get_Nouryoku(Cells(Low, Col))
'変数の値変更
Col = Col + 1
'体力確定
Cells(Low, Col) = (Cells(Low, Col) + Hosei(2))
Cells(Low - 1, Col) = Get_Nouryoku(Cells(Low, Col))
'変数の値変更
Col = Col + 1
'回復確定
Cells(Low, Col) = (Cells(Low, Col) + Hosei(1))
Cells(Low - 1, Col) = Get_Kaifuku(Cells(Low, Col))
End If
Next y
End Sub
Public Function Get_Touho(Atai As Byte) As String
Select Case Atai
Case Is <= Sheets("設定表").Range("AC3")
Get_Touho = Sheets("設定表").Range("AD3")
Case Is <= Sheets("設定表").Range("AC4")
Get_Touho = Sheets("設定表").Range("AD4")
Case Is <= Sheets("設定表").Range("AC5")
Get_Touho = Sheets("設定表").Range("AD5")
Case Is <= Sheets("設定表").Range("AC6")
Get_Touho = Sheets("設定表").Range("AD6")
Case Is <= Sheets("設定表").Range("AC7")
Get_Touho = Sheets("設定表").Range("AD7")
Case Else
Get_Touho = Sheets("設定表").Range("AD8")
End Select
End Function
Public Function Get_PType(Atai As Byte) As String
Select Case Atai
Case Is <= Sheets("設定表").Range("AC11")
Get_PType = Sheets("設定表").Range("AD11")
Case Is <= Sheets("設定表").Range("AC12")
Get_PType = Sheets("設定表").Range("AD12")
Case Is <= Sheets("設定表").Range("AC13")
Get_PType = Sheets("設定表").Range("AD13")
Case Is <= Sheets("設定表").Range("AC14")
Get_PType = Sheets("設定表").Range("AD14")
Case Is <= Sheets("設定表").Range("AC15")
Get_PType = Sheets("設定表").Range("AD15")
Case Else
Get_PType = Sheets("設定表").Range("AD16")
End Select
End Function
Public Function Get_Kyusoku(Atai As Integer, PStyle As String) As Integer
Get_Kyusoku = Int(Atai / 10) + 128
If PStyle = "o" Then
Get_Kyusoku = Get_Kyusoku + 2
ElseIf PStyle = "u" Then
Get_Kyusoku = Get_Kyusoku - 2
End If
If Get_Kyusoku > 158 Then
Get_Kyusoku = 158
End If
If Get_Kyusoku < 128 Then
Get_Kyusoku = 128
End If
End Function
Public Function Get_Kaifuku(Atai As Integer)
Get_Kaifuku = Int(Atai / 15) + 15
End Function
Public Function 投手成長(SName As String)
Dim Low As Byte '行
Dim Col As Byte '列
Dim i As Byte 'ショートループ
Dim j As Byte '年齢ループ
Dim k As Byte '選手数分ループ
Dim L As Byte '設定年齢と実年齢の年数差
Dim ID As Integer '名前ID番号
Dim Nenrei As Byte '現在の年齢
Dim SetteiNenrei As Byte '設定年齢
Dim Nenreisa As Byte '15歳から現在までの経過年数
Dim PStyle As String '投手タイプ
Dim PStyle2 As String '投法
Dim Kokoro(1) As String '心の(0)成長タイプ:(1)成長モード
Dim Waza(1) As String '技の(0)成長タイプ:(1)成長モード
Dim Karada(1) As String '体の(0)成長タイプ:(1)成長モード
Dim Avipoint As Single '特徴ポイント確率補正
Dim IntNoryoku As Integer '能力指数
Dim GetFrg As Boolean '引退フラグ
Dim ch As Byte
On Error GoTo err
'変数初期設定
Low = 0
Worksheets(SName).Activate
For k = 1 To 46
Low = Low + 3
Col = 2
GetFrg = False
Cells(Low - 1, 1).Select
Selection.Font.ColorIndex = 0
If Cells(Low - 1, Col) > 1 Then
'年齢の取得
Nenrei = Cells(Low - 1, Col)
SetteiNenrei = Cells(Low, Col)
'成長タイプ取得
Kokoro(0) = Cells(Low - 1, Col + 1)
Waza(0) = Cells(Low - 1, Col + 2)
Karada(0) = Cells(Low - 1, Col + 3)
L = SetteiNenrei - Nenrei
For j = 1 To L
Col = 2
'投法タイプ変更
ch = Saikoro
If ch = 33 And _
Cells(Low, Col + 6) <= 240 And _
Cells(Low, Col + 7) <= 240 And _
Cells(Low, Col + 8) <= 240 And _
Cells(Low, Col + 9) <= 240 And _
Cells(Low, Col + 10) <= 240 Then
PStyle = Right(Cells(Low - 1, Col + 4), 1)
ch = Saikoro(10)
Select Case PStyle
Case "o"
Cells(Low - 1, Col + 4) = Left(Cells(Low - 1, Col + 4), 1) & "s"
Cells(Low, Col + 7) = Cells(Low, Col + 7) + 7
Cells(Low, Col + 8) = Cells(Low, Col + 8) + 13
Case "s"
If ch < 6 Then
Cells(Low - 1, Col + 4) = Left(Cells(Low - 1, Col + 4), 1) & "o"
Cells(Low, Col + 7) = Cells(Low, Col + 7) + 13
Cells(Low, Col + 10) = Cells(Low, Col + 10) + 7
Else
Cells(Low - 1, Col + 4) = Left(Cells(Low - 1, Col + 4), 1) & "u"
Cells(Low, Col + 8) = Cells(Low, Col + 8) + 7
Cells(Low, Col + 9) = Cells(Low, Col + 9) + 13
End If
Case "u"
Cells(Low - 1, Col + 4) = Left(Cells(Low - 1, Col + 4), 1) & "s"
Cells(Low, Col + 6) = Cells(Low, Col + 6) + 7
Cells(Low, Col + 7) = Cells(Low, Col + 7) + 13
End Select
ElseIf ch = 77 And _
Cells(Low, Col + 6) <= 235 And _
Cells(Low, Col + 7) <= 235 And _
Cells(Low, Col + 8) <= 235 And _
Cells(Low, Col + 9) <= 235 And _
Cells(Low, Col + 10) <= 235 Then
PStyle = Cells(Low - 1, Col + 5)
Do
Cells(Low, Col + 5) = Saikoro
PStyle2 = Get_PType(Cells(Low, Col + 5))
Loop Until PStyle2 <> PStyle
Cells(Low - 1, Col + 5) = PStyle2
Select Case Cells(Low - 1, Col + 5)
Case "D"
Cells(Low, Col + 8) = Cells(Low, Col + 8) + 10
Cells(Low, Col + 9) = Cells(Low, Col + 9) + 10
Cells(Low, Col + 11) = Cells(Low, Col + 11) + 10
Case "C"
Cells(Low, Col + 7) = Cells(Low, Col + 7) + 10
Cells(Low, Col + 8) = Cells(Low, Col + 8) + 10
Cells(Low, Col + 11) = Cells(Low, Col + 11) + 10
Case "B", "B+"
Cells(Low, Col + 6) = Cells(Low, Col + 6) + 10
Cells(Low, Col + 7) = Cells(Low, Col + 7) + 10
Cells(Low, Col + 10) = Cells(Low, Col + 10) + 10
Case Else
Cells(Low, Col + 7) = Cells(Low, Col + 7) + 10
Cells(Low, Col + 8) = Cells(Low, Col + 8) + 10
Cells(Low, Col + 10) = Cells(Low, Col + 10) + 10
End Select
End If
'投手スタイル取得
PStyle = Right(Cells(Low - 1, Col + 4), 1)
PStyle2 = Left(Cells(Low - 1, Col + 5), 1)
'年齢の再取得
Nenrei = Cells(Low - 1, Col)
'年齢差取得
Nenreisa = Nenrei - 15 + 3
If Nenreisa >= 30 Then
Nenreisa = 29
End If
'現在の成長モード取得
'心の成長モードセル取得
Select Case Kokoro(0)
Case "早熟"
Kokoro(1) = "I" & CStr(Nenreisa)
Case "普通"
Kokoro(1) = "L" & CStr(Nenreisa)
Case "晩成"
Kokoro(1) = "O" & CStr(Nenreisa)
Case "安定"
Kokoro(1) = "R" & CStr(Nenreisa)
Case Else
Kokoro(1) = "U" & CStr(Nenreisa)
End Select
'技の成長モードセル取得
Select Case Waza(0)
Case "早熟"
Waza(1) = "J" & CStr(Nenreisa)
Case "普通"
Waza(1) = "M" & CStr(Nenreisa)
Case "晩成"
Waza(1) = "P" & CStr(Nenreisa)
Case "安定"
Waza(1) = "S" & CStr(Nenreisa)
Case Else
Waza(1) = "V" & CStr(Nenreisa)
End Select
'体の成長モードセル取得
Select Case Karada(0)
Case "早熟"
Karada(1) = "K" & CStr(Nenreisa)
Case "普通"
Karada(1) = "N" & CStr(Nenreisa)
Case "晩成"
Karada(1) = "Q" & CStr(Nenreisa)
Case "安定"
Karada(1) = "T" & CStr(Nenreisa)
Case Else
Karada(1) = "W" & CStr(Nenreisa)
End Select
'心技体成長モード取得
Kokoro(1) = Sheets("設定表").Range(Kokoro(1))
Waza(1) = Sheets("設定表").Range(Waza(1))
Karada(1) = Sheets("設定表").Range(Karada(1))
Col = Col + 6
Avipoint = 0
'球速
'アベレージポイント判定
Avipoint = Cells(Low + 1, Col)
'能力指数Up
IntNoryoku = Cells(Low, Col)
Call NouryokuUp(Karada(1), IntNoryoku, GetFrg, Avipoint)
Cells(Low, Col) = IntNoryoku
'能力指数Down
IntNoryoku = Cells(Low, Col)
Call NouryokuDown(Karada(1), IntNoryoku, GetFrg, Avipoint)
Cells(Low, Col) = IntNoryoku
If PStyle2 = "B" Then
IntNoryoku = IntNoryoku + 8
ElseIf PStyle2 = "A" Then
IntNoryoku = IntNoryoku + 7
End If
'能力値決定
Cells(Low - 1, Col) = Get_Kyusoku(IntNoryoku, PStyle)
'変数の値変更
Col = Col + 1
'切れ決定
'アベレージポイント判定
Avipoint = Cells(Low + 1, Col)
'能力指数Up
IntNoryoku = Cells(Low, Col)
Call NouryokuUp(Waza(1), IntNoryoku, GetFrg, Avipoint)
Cells(Low, Col) = IntNoryoku
'能力指数Down
IntNoryoku = Cells(Low, Col)
Call NouryokuDown(Waza(1), IntNoryoku, GetFrg, Avipoint)
Cells(Low, Col) = IntNoryoku
'能力値決定
If Right(PStyle, 1) = "s" Then
IntNoryoku = IntNoryoku + 8
ElseIf Right(PStyle, 1) = "u" Then
IntNoryoku = IntNoryoku + 5
End If
If PStyle2 = "A" Then
IntNoryoku = IntNoryoku + 7
ElseIf PStyle2 = "C" Then
IntNoryoku = IntNoryoku + 7
ElseIf PStyle2 = "D" Then
IntNoryoku = IntNoryoku + 3
End If
Cells(Low - 1, Col) = Get_Nouryoku(IntNoryoku)
'変数の値変更
Col = Col + 1
'制球決定
'アベレージポイント判定
Avipoint = Cells(Low + 1, Col)
'能力指数Up
IntNoryoku = Cells(Low, Col)
Call NouryokuUp(Waza(1), IntNoryoku, GetFrg, Avipoint)
Cells(Low, Col) = IntNoryoku
'能力指数Down
IntNoryoku = Cells(Low, Col)
Call NouryokuDown(Waza(1), IntNoryoku, GetFrg, Avipoint)
Cells(Low, Col) = IntNoryoku
'能力値決定
If Right(PStyle, 1) = "s" Then
IntNoryoku = IntNoryoku + 7
ElseIf Right(PStyle, 1) = "u" Then
IntNoryoku = IntNoryoku + 10
End If
If PStyle2 = "B" Then
IntNoryoku = IntNoryoku + 6
ElseIf PStyle2 = "C" Then
IntNoryoku = IntNoryoku + 7
ElseIf PStyle2 = "D" Then
IntNoryoku = IntNoryoku + 5
End If
Cells(Low - 1, Col) = Get_Nouryoku(IntNoryoku)
'変数の値変更
Col = Col + 1
'安定決定
'アベレージポイント判定
Avipoint = Cells(Low + 1, Col)
'能力指数Up
IntNoryoku = Cells(Low, Col)
Call NouryokuUp(Kokoro(1), IntNoryoku, GetFrg, Avipoint)
Cells(Low, Col) = IntNoryoku
'能力指数Down
IntNoryoku = Cells(Low, Col)
Call NouryokuDown(Kokoro(1), IntNoryoku, GetFrg, Avipoint)
Cells(Low, Col) = IntNoryoku
'能力値決定
If Right(PStyle, 1) = "u" Then
IntNoryoku = IntNoryoku + 10
ElseIf Right(PStyle, 1) = "s" Then
IntNoryoku = IntNoryoku + 5
End If
If PStyle2 = "D" Then
IntNoryoku = IntNoryoku + 7
End If
Cells(Low - 1, Col) = Get_Nouryoku(IntNoryoku)
'変数の値変更
Col = Col + 1
'球質決定
'アベレージポイント判定
Avipoint = Cells(Low + 1, Col)
'能力指数Up
IntNoryoku = Cells(Low, Col)
Call NouryokuUp(Karada(1), IntNoryoku, GetFrg, Avipoint)
Cells(Low, Col) = IntNoryoku
'能力指数Down
IntNoryoku = Cells(Low, Col)
Call NouryokuDown(Karada(1), IntNoryoku, , Avipoint)
Cells(Low, Col) = IntNoryoku
'能力値決定
If PStyle2 = "B" Then
IntNoryoku = IntNoryoku + 6
End If
Cells(Low - 1, Col) = Get_Nouryoku(IntNoryoku)
'変数の値変更
Col = Col + 1
'技術決定
'アベレージポイント判定
Avipoint = Cells(Low + 1, Col)
'能力指数Up
IntNoryoku = Cells(Low, Col)
Call NouryokuUp(Kokoro(1), IntNoryoku, GetFrg, Avipoint)
Cells(Low, Col) = IntNoryoku
'能力指数Down
IntNoryoku = Cells(Low, Col)
Call NouryokuDown(Kokoro(1), IntNoryoku, , Avipoint)
Cells(Low, Col) = IntNoryoku
'能力値決定
If Right(PStyle, 1) = "u" Then
IntNoryoku = IntNoryoku + 10
End If
If PStyle2 = "D" Then
IntNoryoku = IntNoryoku + 5
End If
Cells(Low - 1, Col) = Get_Nouryoku(IntNoryoku)
'変数の値変更
Col = Col + 1
'体力決定
'アベレージポイント判定
Avipoint = Cells(Low + 1, Col)
'能力指数Up
IntNoryoku = Cells(Low, Col)
Call NouryokuUp(Karada(1), IntNoryoku, GetFrg, Avipoint)
Cells(Low, Col) = IntNoryoku
'能力指数Down
IntNoryoku = Cells(Low, Col)
Call NouryokuDown(Karada(1), IntNoryoku, GetFrg, Avipoint)
Cells(Low, Col) = IntNoryoku
'能力値決定
If Right(PStyle, 1) = "u" Then
IntNoryoku = IntNoryoku + 5
End If
IntNoryoku = IntNoryoku + 20
Cells(Low - 1, Col) = Get_Nouryoku(IntNoryoku)
'変数の値変更
Col = Col + 1
'回復決定
'アベレージポイント判定
Avipoint = Cells(Low + 1, Col)
'能力指数Up
IntNoryoku = Cells(Low, Col)
Call NouryokuUp(Waza(1), IntNoryoku, GetFrg, Avipoint)
Cells(Low, Col) = IntNoryoku
'能力指数Down
IntNoryoku = Cells(Low, Col)
Call NouryokuDown(Waza(1), IntNoryoku, GetFrg, Avipoint)
Cells(Low, Col) = IntNoryoku
'能力値決定
Cells(Low - 1, Col) = Get_Kaifuku(IntNoryoku)
'年齢を加算
Col = Col - 13
Cells(Low - 1, Col) = (Cells(Low - 1, Col)) + 1
If Cells(Low - 1, Col) >= 50 Then
GetFrg = True
End If
Col = Col + 13
'引退フラグ
If GetFrg = True Then
Cells(Low - 1, Col + 1) = "退団"
For i = 0 To 6
Cells(Low - 1, Col - i) = ""
Next i
Else
Select Case k
Case Is <= 6
Cells(Low - 1, Col + 1) = "先発"
Cells(Low, Col + 1) = k
Case Is <= 10
Cells(Low - 1, Col + 1) = "中継ぎ"
Cells(Low, Col + 1) = k
Case Is <= 12
Cells(Low - 1, Col + 1) = "抑え"
Cells(Low, Col + 1) = k
Case Is <= 36
Cells(Low - 1, Col + 1) = "２軍"
Cells(Low, Col + 1) = k
Case Is <= 41
Cells(Low - 1, Col + 1) = "外人"
Cells(Low, Col + 1) = k
Case Else
Cells(Low - 1, Col + 1) = "新人"
Cells(Low, Col + 1) = k
End Select
End If
Next j
End If
Next k
Exit Function
err:
MsgBox err.Description
Resume Next
End Function
Public Sub 投手陣並び替え()
Dim i As Byte
Dim j As Byte '選手数36名
Dim Low As Byte
Dim Col As Byte
Dim movlow As Byte
For i = 1 To 3
'初期設定
Col = 20
Low = 107
For j = 1 To 36
'先発への移動
If Cells(Low, Col - 4) = "先発" Then
movlow = 2
'空いている行を探す
Do Until Cells(movlow, Col - 4) = ""
movlow = movlow + 3
Loop
If Low <> movlow Then
'各項目の移動
If movlow < 18 Then
Call 選手移動(movlow, Low, Col)
End If
End If
ElseIf Cells(Low, Col - 4) = "中継ぎ" Then
'2軍への移動
movlow = 20
'空いている行を探す
Do Until Cells(movlow, Col - 4) = ""
movlow = movlow + 3
Loop
If Low <> movlow Then
'各項目の移動
If movlow < 30 And movlow > 19 Then
Call 選手移動(movlow, Low, Col)
End If
End If
ElseIf Cells(Low, Col - 4) = "抑え" Then
'2軍への移動
movlow = 32
'空いている行を探す
Do Until Cells(movlow, Col - 4) = ""
movlow = movlow + 3
Loop
If Low <> movlow Then
'各項目の移動
If movlow < 36 And movlow > 31 Then
Call 選手移動(movlow, Low, Col)
End If
End If
ElseIf Cells(Low, Col - 4) = "２軍" Then
'2軍への移動
movlow = 38
'空いている行を探す
Do Until Cells(movlow, Col - 4) = ""
movlow = movlow + 3
Loop
If Low <> movlow Then
'各項目の移動
If movlow < 108 And movlow > 31 Then
Call 選手移動(movlow, Low, Col)
End If
End If
End If
If Low > 3 Then
Low = Low - 3
End If
Next j
Next i
End Sub
'Newleague True:新規球団作成 False:２年目以降の新人・外人作成
Public Sub 野手作成(SName As String, Optional Newleague As Boolean = True)
' 開発開始日 : 2019/11/13 ユーザー名 : ZAKI
Dim y As Byte '野手の作成ループ回数
Dim i As Integer 'ループ変数
Dim j As Byte '野手の作成開始：新規=0 ２年目以降=24
Dim Low As Byte 'ワークシートの行
Dim Col As Byte 'ワークシートの列
Dim Hosei(2) As Byte '成長タイプにおける初期補正値0:(心),1:(技),2:(体)
Dim Point As Byte '一時格納変数(守備：守備指数、打撃指数：補正指数、特徴：特徴コード)
Dim BStyle As String '打席タイプ
Dim Syubi As Byte 'メイン守備位置
Dim Jinsyu As String '人種
Dim Bk_Sisu(1) As Byte '能力値決定時一時保管用
Dim UnicPoint As Byte '選手の能力成長補正ポイント:成長確率に加算
Worksheets(SName).Activate
'選手名を作成
If Newleague = True Then
Call Get_Name(SName, True)
j = 0
Else
Call Get_Name(SName, False)
j = 34
End If
'選手数分だけループ
For y = j To 43
'初期変数設定
Low = 3
Low = Low + (y * 3) '選手数分だけ行をずらす。
Col = 3
i = 0
Point = 0
'名前部分を選択
Cells(Low - 1, 1).Select
Selection.Font.ColorIndex = 0
'外人対策
If Newleague = False And Cells(Low, 2) > 1 Then
Else
'今季年齢決定
Select Case y
Case Is <= 33 '既存選手
Cells(Low, Col - 1) = 18 + (Saikoro(17)) + 1
Case Is >= 39 '新人
Cells(Low, Col - 1) = 18 + ((Saikoro(4) * 2) - 2) + 1
Case Else '外人
Cells(Low, Col - 1) = 25 + (Saikoro(9)) + 1
End Select
'初期年齢設定
Cells(Low - 1, Col - 1) = 16
'基本能力値決定（項目分だけ作成）:i=0心：i=20打撃指数
For i = 0 To 20
'守備から打撃指数までは（１～128）
'肩と選球眼と体力と打撃指数は２回の内どちらか良い方を選択
If i >= 5 And i <= 20 Then
If i = 10 Or i = 11 Or i = 13 Or i = 15 Or i = 20 Then
Bk_Sisu(0) = Saikoro(128)
Bk_Sisu(1) = Saikoro(128)
If Bk_Sisu(0) > Bk_Sisu(1) Then
Cells(Low, Col + i) = Bk_Sisu(0)
Else
Cells(Low, Col + i) = Bk_Sisu(1)
End If
Else
Cells(Low, Col + i) = Saikoro(128)
End If
Else
Cells(Low, Col + i) = Saikoro(100)
End If
'選手の能力成長補正ポイントを作成・書き込み
If Col + i > 7 Then
Cells(Low + 1, Col + i) = Saikoro(9)
End If
Next i
'人種判定:行により決定：外人は外人枠から移動しない為
If y > 34 And y < 40 Then
Jinsyu = "外人"
Else
Jinsyu = "日本人"
End If
'成長タイプ確定：心・技・体
For i = 0 To 2
Cells(Low - 1, Col + i) = Get_SeityoType(Cells(Low, Col + i).Value, i, Point, Jinsyu)
'成長タイプにおける初期補正値獲得
Hosei(i) = Point
Next i
'変数の値変更
Col = Col + 3
'打席確定
Cells(Low - 1, Col) = Get_Daseki(Cells(Low, Col))
BStyle = Cells(Low - 1, Col)
'変数の値変更
Col = Col + 1
'タイプ確定
Cells(Low - 1, Col) = Get_Type(Cells(Low, Col))
BStyle = BStyle & Cells(Low - 1, Col)
'全守備力確定：
Point = 0
For i = 1 To 6
'外人のファーストと外野以外の守備力を下げる。
If Jinsyu = "外人" Then
If i <> 2 And i <> 6 Then
Cells(Low, Col + i) = Int((Cells(Low, Col + i) + Hosei(1) - 10) * 0.9)
Else
Cells(Low, Col + i) = (Cells(Low, Col + i) + Hosei(1))
End If
Else
Cells(Low, Col + i) = (Cells(Low, Col + i) + Hosei(1))
End If
'最大守備力取得：Point=Max守備力
If Point < Cells(Low, Col + i) Then
Point = Cells(Low, Col + i)
Syubi = i
End If
'各守備力を一時的に決定
Cells(Low - 1, Col + i) = Get_Nouryoku(Cells(Low, Col + i))
Next i
Point = 0
'最終守備力確定
For i = 1 To 6
'最大守備位置以外削除
If i <> Syubi Then
Cells(Low - 1, Col + i) = ""
Else
'本職の守備位置書き込み
Select Case Syubi
Case 1
Cells(Low + 1, 1) = "捕手"
Case 2
Cells(Low + 1, 1) = "ファースト"
Case 3
Cells(Low + 1, 1) = "セカンド"
Case 4
Cells(Low + 1, 1) = "サード"
Case 5
Cells(Low + 1, 1) = "ショート"
Case Else
Cells(Low + 1, 1) = "外野"
End Select
End If
'キャッチャーの他の守備力を下げる。
If Syubi = 1 And i <> 1 Then
Point = Point + Int(Cells(Low, Col + i) * 0.1)
Cells(Low, Col + i) = Int(Cells(Low, Col + i) * 0.9)
End If
'内野手の他の守備力を上げる。
If Syubi = 2 And i = 6 Then
Cells(Low, Col + i) = Int(Cells(Low, Col + i) * 1.1)
End If
If Syubi = 3 And i <> 3 And i >= 2 And i < 5 Then
Cells(Low, Col + i) = Int(Cells(Low, Col + i) * 1.2)
ElseIf Syubi = 3 And i = 5 Then
Cells(Low, Col + i) = Int(Cells(Low, Col + i) * 1.1)
End If
If Syubi = 4 And i <> 4 And i = 2 Then
Cells(Low, Col + i) = Int(Cells(Low, Col + i) * 1.2)
ElseIf Syubi = 4 And i = 3 Then
Cells(Low, Col + i) = Int(Cells(Low, Col + i) * 1.1)
End If
If Syubi = 5 And i <> 5 And i >= 3 And i < 6 Then
Cells(Low, Col + i) = Int(Cells(Low, Col + i) * 1.2)
ElseIf Syubi = 5 And i = 6 Then
Cells(Low, Col + i) = Int(Cells(Low, Col + i) * 1.1)
End If
'外野手の他の守備力を下げる。
If Syubi = 6 And i <> 6 And i <> 2 Then
Cells(Low, Col + i) = Int(Cells(Low, Col + i) * 0.9)
End If
Next i
'変数の値変更
Col = Col + 7
'肩力決定
If Syubi = 1 Then
If Cells(Low, Col) = ((Cells(Low, Col) + Hosei(2)) + Point) > 245 Then
Cells(Low, Col) = 245
Else
Cells(Low, Col) = ((Cells(Low, Col) + Hosei(2)) + Point)
End If
Else
Cells(Low, Col) = (Cells(Low, Col) + Hosei(2))
End If
Cells(Low - 1, Col) = Get_Nouryoku(Cells(Low, Col))
'変数の値変更
Col = Col + 1
'走力決定
Cells(Low, Col) = Cells(Low, Col) + Hosei(1)
Cells(Low - 1, Col) = Get_Nouryoku(Cells(Low, Col))
'変数の値変更
Col = Col + 1
'選球眼決定
Cells(Low, Col) = Cells(Low, Col) + Hosei(0)
Cells(Low - 1, Col) = Get_Nouryoku(Cells(Low, Col))
'変数の値変更
Col = Col + 1
'実績決定
Cells(Low, Col) = Cells(Low, Col) + Hosei(0)
Cells(Low - 1, Col) = Get_Nouryoku(Cells(Low, Col))
'変数の値変更
Col = Col + 1
'体力決定
Cells(Low, Col) = Cells(Low, Col) + Hosei(2)
Cells(Low - 1, Col) = Get_Nouryoku(Cells(Low, Col))
'変数の値変更
Col = Col + 1
'好打決定
Cells(Low, Col) = Cells(Low, Col) + Hosei(1)
Cells(Low - 1, Col) = Get_Nouryoku(Cells(Low, Col))
'変数の値変更
Col = Col + 1
'長打決定
Cells(Low, Col) = Cells(Low, Col) + Hosei(2)
Cells(Low - 1, Col) = Get_Nouryoku(Cells(Low, Col))
'変数の値変更
Col = Col + 1
'信頼決定
Cells(Low, Col) = Cells(Low, Col) + Hosei(0)
Cells(Low - 1, Col) = Get_Sinrai(Cells(Low, Col), BStyle)
'変数の値変更
Col = Col + 1
'対左決定
Cells(Low, Col) = Cells(Low, Col) + Hosei(0)
Cells(Low - 1, Col) = Get_KillLeft(Cells(Low, Col), BStyle)
'変数の値変更
Col = Col + 1
Point = 0
'打撃指数決定（下記指数UP）
'Ｌ打者+10：Ｂ打者+5：打者タイプＳ+10
If Left(BStyle, 1) = "L" Then
Point = Point + 10
ElseIf Left(BStyle, 1) = "B" Then
Point = Point + 5
End If
If Right(BStyle, 1) = "S" Then
Point = Point + 10
End If
Cells(Low, Col) = Cells(Low, Col) + Hosei(1) + Point
Cells(Low - 1, Col) = Get_Daritu(Cells(Low, Col))
End If
Next y
End Sub
Public Function Get_Daseki(Atai As Byte) As String
Select Case Atai
Case Is <= Sheets("設定表").Range("D3")
Get_Daseki = Sheets("設定表").Range("E3")
Case Is <= Sheets("設定表").Range("D4")
Get_Daseki = Sheets("設定表").Range("E4")
Case Else
Get_Daseki = Sheets("設定表").Range("E5")
End Select
End Function
Public Function Get_Type(Atai As Byte) As String
Select Case Atai
Case Is <= 60
Get_Type = Sheets("設定表").Range("E8")
Case Else
Get_Type = Sheets("設定表").Range("E9")
End Select
End Function
Public Function Get_Sinrai(Atai As Integer, BStyle As String) As String
If Right(BStyle, 1) = "P" And Atai < 245 Then
Atai = Atai + 10
End If
Select Case Atai
Case Is >= Sheets("設定表").Range("B27")
Get_Sinrai = Sheets("設定表").Range("E27")
Case Is >= Sheets("設定表").Range("B28")
Get_Sinrai = Sheets("設定表").Range("E28")
Case Is >= Sheets("設定表").Range("B29")
Get_Sinrai = Sheets("設定表").Range("E29")
Case Is >= Sheets("設定表").Range("B30")
Get_Sinrai = Sheets("設定表").Range("E30")
Case Is >= Sheets("設定表").Range("B31")
Get_Sinrai = Sheets("設定表").Range("E31")
End Select
End Function
Public Function Get_KillLeft(Atai As Integer, BStyle As String) As String
If Right(BStyle, 1) = "S" And Atai < 245 Then
Atai = Atai + 10
End If
Select Case Left(BStyle, 1)
Case "B"
Atai = 70
Case "L"
Atai = Int(Atai / 3)
Case "R"
If Atai <= 50 Then
Atai = 50
End If
End Select
Select Case Atai
Case Is >= Sheets("設定表").Range("B34")
Get_KillLeft = Sheets("設定表").Range("E34")
Case Is >= Sheets("設定表").Range("B35")
Get_KillLeft = Sheets("設定表").Range("E35")
Case Is >= Sheets("設定表").Range("B36")
Get_KillLeft = Sheets("設定表").Range("E36")
Case Is >= Sheets("設定表").Range("B37")
Get_KillLeft = Sheets("設定表").Range("E37")
Case Is >= Sheets("設定表").Range("B38")
Get_KillLeft = Sheets("設定表").Range("E38")
End Select
End Function
Public Function Get_Daritu(Atai As Byte) As Integer
Get_Daritu = (Int(Atai / 8) * 5) + 200
End Function
Public Function 野手成長(SName As String)
Dim Low As Byte '行
Dim Col As Byte '列
Dim i As Byte 'ショートループ
Dim j As Byte '年齢ループ
Dim k As Byte '選手数ループ
Dim L As Byte '設定年齢と実年齢の年数差
Dim ID As Integer '名前ID番号
Dim Nenrei As Byte '現在の年齢
Dim SetteiNenrei As Byte '設定年齢
Dim Nenreisa As Byte '15歳から現在までの経過年数
Dim BStyle As String '打者タイプ
Dim Kokoro(1) As String '心の(0)成長タイプ:(1)成長モード
Dim Waza(1) As String '技の(0)成長タイプ:(1)成長モード
Dim Karada(1) As String '体の(0)成長タイプ:(1)成長モード
Dim Avipoint As Byte '特徴ポイント(確率補正)
Dim IntNoryoku As Integer '能力指数
Dim MaxNoryoku As Byte '最大能力値
Dim MaxIti As Byte '最大能力位置
Dim GetFrg As Boolean 'サブポジション獲得：引退フラグ
Dim ch As Byte 'クリティカル判定と確率ループに使用
On Error GoTo err
'変数初期設定
Low = 0
Worksheets(SName).Activate
For k = 1 To 44
Low = Low + 3
Col = 2
MaxNoryoku = 0
GetFrg = False
Cells(Low - 1, 1).Select
Selection.Font.ColorIndex = 0
If Cells(Low - 1, Col) > 1 Then
'年齢の取得
Nenrei = Cells(Low - 1, Col)
SetteiNenrei = Cells(Low, Col)
'成長タイプ取得
Kokoro(0) = Cells(Low - 1, Col + 1)
Waza(0) = Cells(Low - 1, Col + 2)
Karada(0) = Cells(Low - 1, Col + 3)
L = SetteiNenrei - Nenrei
For j = 1 To L
Col = 2
'タイプ変更
ch = Saikoro
If ch = 33 Or ch = 77 Then
If Cells(Low - 1, Col + 5) = "P" Then
Cells(Low - 1, Col + 5) = "S"
ch = Saikoro
If ch <= 70 And _
Cells(Low, Col + 17) <= 235 And _
Cells(Low, Col + 14) <= 245 Then
Cells(Low, Col + 17) = Cells(Low, Col + 17) + 13
Cells(Low, Col + 14) = Cells(Low, Col + 14) + 7
Else
If Cells(Low, Col + 18) >= 20 And _
Cells(Low, Col + 17) <= 225 And _
Cells(Low, Col + 14) <= 235 Then
Cells(Low, Col + 18) = Cells(Low, Col + 18) - 20
Cells(Low, Col + 17) = Cells(Low, Col + 17) + 26
Cells(Low, Col + 14) = Cells(Low, Col + 14) + 14
End If
End If
Else
Cells(Low - 1, Col + 5) = "P"
ch = Saikoro(10)
If ch <= 70 And _
Cells(Low, Col + 17) <= 235 And _
Cells(Low, Col + 14) <= 245 Then
Cells(Low, Col + 18) = Cells(Low, Col + 18) + 13
Cells(Low, Col + 14) = Cells(Low, Col + 14) + 7
Else
If Cells(Low, Col + 17) >= 20 And _
Cells(Low, Col + 18) <= 225 And _
Cells(Low, Col + 14) <= 235 Then
Cells(Low, Col + 17) = Cells(Low, Col + 17) - 20
Cells(Low, Col + 18) = Cells(Low, Col + 18) + 26
Cells(Low, Col + 14) = Cells(Low, Col + 14) + 14
End If
End If
End If
End If
'打者タイプ取得
BStyle = Cells(Low - 1, Col + 4) & Cells(Low - 1, Col + 5)
'年齢の再取得
Nenrei = Cells(Low - 1, Col)
'年齢差取得
Nenreisa = Nenrei - 15 + 3
If Nenreisa >= 30 Then
Nenreisa = 29
End If
'現在の成長モード取得
'心の成長モードセル取得
Select Case Kokoro(0)
Case "早熟"
Kokoro(1) = "I" & CStr(Nenreisa)
Case "普通"
Kokoro(1) = "L" & CStr(Nenreisa)
Case "晩成"
Kokoro(1) = "O" & CStr(Nenreisa)
Case "安定"
Kokoro(1) = "R" & CStr(Nenreisa)
Case Else
Kokoro(1) = "U" & CStr(Nenreisa)
End Select
'技の成長モードセル取得
Select Case Waza(0)
Case "早熟"
Waza(1) = "J" & CStr(Nenreisa)
Case "普通"
Waza(1) = "M" & CStr(Nenreisa)
Case "晩成"
Waza(1) = "P" & CStr(Nenreisa)
Case "安定"
Waza(1) = "S" & CStr(Nenreisa)
Case Else
Waza(1) = "V" & CStr(Nenreisa)
End Select
'体の成長モードセル取得
Select Case Karada(0)
Case "早熟"
Karada(1) = "K" & CStr(Nenreisa)
Case "普通"
Karada(1) = "N" & CStr(Nenreisa)
Case "晩成"
Karada(1) = "Q" & CStr(Nenreisa)
Case "安定"
Karada(1) = "T" & CStr(Nenreisa)
Case Else
Karada(1) = "W" & CStr(Nenreisa)
End Select
'心技体成長モード取得
Kokoro(1) = Sheets("設定表").Range(Kokoro(1))
Waza(1) = Sheets("設定表").Range(Waza(1))
Karada(1) = Sheets("設定表").Range(Karada(1))
'守備力Up判定
For i = 1 To 6
Col = 7
Col = Col + i
'能力指数Up
IntNoryoku = Cells(Low, Col)
'アベレージポイント取得
Avipoint = Cells(Low + 1, Col)
'能力アップ
Call NouryokuUp(Waza(1), IntNoryoku, GetFrg, Avipoint)
Cells(Low, Col) = IntNoryoku
'能力指数Down
Call NouryokuDown(Waza(1), IntNoryoku, GetFrg, Avipoint)
Cells(Low, Col) = IntNoryoku
'メインポジションと能力指数探索
If MaxNoryoku < Cells(Low, Col) Then
MaxNoryoku = Cells(Low, Col)
MaxIti = i
End If
'能力値が規定以下
If GetFrg = True Then
Cells(Low - 1, Col) = ""
GetFrg = False
End If
'ベスプレ用能力値書きこみ
If Len(Cells(Low - 1, Col)) <> 0 Then
Cells(Low - 1, Col) = Get_Nouryoku(IntNoryoku)
End If
Next i
'サブポジション書きこみ（キャッチャー以外）
Col = Col - 6
IntNoryoku = Cells(Low, Col + MaxIti)
If MaxIti <> 1 Then
Cells(Low - 1, Col + MaxIti) = Get_Nouryoku(IntNoryoku)
End If
'本職の守備位置書き込み
Select Case MaxIti
Case 1
Cells(Low + 1, 1) = "捕手"
Case 2
Cells(Low + 1, 1) = "ファースト"
Case 3
Cells(Low + 1, 1) = "セカンド"
Case 4
Cells(Low + 1, 1) = "サード"
Case 5
Cells(Low + 1, 1) = "ショート"
Case Else
Cells(Low + 1, 1) = "外野"
End Select
'変数の値変更
Col = Col + 7
GetFrg = False
'肩力
'アベレージポイント取得
Avipoint = Cells(Low + 1, Col)
'能力指数Up
IntNoryoku = Cells(Low, Col)
Call NouryokuUp(Karada(1), IntNoryoku, GetFrg, Avipoint)
Cells(Low, Col) = IntNoryoku
'能力指数Down
IntNoryoku = Cells(Low, Col)
Call NouryokuDown(Karada(1), IntNoryoku, GetFrg, Avipoint)
Cells(Low, Col) = IntNoryoku
'能力値決定
Cells(Low - 1, Col) = Get_Nouryoku(IntNoryoku)
'変数の値変更
Col = Col + 1
'走力決定
'アベレージポイント取得
Avipoint = Cells(Low + 1, Col)
'能力指数Up
IntNoryoku = Cells(Low, Col)
Call NouryokuUp(Waza(1), IntNoryoku, GetFrg, Avipoint)
Cells(Low, Col) = IntNoryoku
'能力指数Down
IntNoryoku = Cells(Low, Col)
Call NouryokuDown(Waza(1), IntNoryoku, GetFrg, Avipoint)
Cells(Low, Col) = IntNoryoku
'能力値決定
Cells(Low - 1, Col) = Get_Nouryoku(IntNoryoku)
'変数の値変更
Col = Col + 1
'選球眼決定
'アベレージポイント取得
Avipoint = Cells(Low + 1, Col)
'能力指数Up
IntNoryoku = Cells(Low, Col)
Call NouryokuUp(Kokoro(1), IntNoryoku, GetFrg, Avipoint)
Cells(Low, Col) = IntNoryoku
'能力指数Down
IntNoryoku = Cells(Low, Col)
Call NouryokuDown(Kokoro(1), IntNoryoku, GetFrg, Avipoint)
Cells(Low, Col) = IntNoryoku
'能力値決定
Cells(Low - 1, Col) = Get_Nouryoku(IntNoryoku)
'変数の値変更
Col = Col + 1
'実績決定
'アベレージポイント取得
Avipoint = Cells(Low + 1, Col)
'能力指数Up
IntNoryoku = Cells(Low, Col)
Call NouryokuUp(Kokoro(1), IntNoryoku, GetFrg, Avipoint)
Cells(Low, Col) = IntNoryoku
'能力指数Down
IntNoryoku = Cells(Low, Col)
Call NouryokuDown(Kokoro(1), IntNoryoku, , Avipoint)
Cells(Low, Col) = IntNoryoku
'能力値決定
Cells(Low - 1, Col) = Get_Nouryoku(IntNoryoku)
'変数の値変更
Col = Col + 1
'体力決定
'アベレージポイント取得
Avipoint = Cells(Low + 1, Col)
'能力指数Up
IntNoryoku = Cells(Low, Col)
Call NouryokuUp(Karada(1), IntNoryoku, GetFrg, Avipoint)
Cells(Low, Col) = IntNoryoku
'能力指数Down
IntNoryoku = Cells(Low, Col)
Call NouryokuDown(Karada(1), IntNoryoku, GetFrg, Avipoint)
Cells(Low, Col) = IntNoryoku
'能力値決定 体力のみ+20
IntNoryoku = IntNoryoku + 20
Cells(Low - 1, Col) = Get_Nouryoku(IntNoryoku)
'変数の値変更
Col = Col + 1
'好打決定
'アベレージポイント取得
Avipoint = Cells(Low + 1, Col)
'能力指数Up
IntNoryoku = Cells(Low, Col)
Call NouryokuUp(Waza(1), IntNoryoku, GetFrg, Avipoint)
Cells(Low, Col) = IntNoryoku
'能力指数Down
IntNoryoku = Cells(Low, Col)
Call NouryokuDown(Waza(1), IntNoryoku, GetFrg, Avipoint)
Cells(Low, Col) = IntNoryoku
'能力値決定
If Right(BStyle, 1) = "S" Then
IntNoryoku = IntNoryoku + 10
End If
Cells(Low - 1, Col) = Get_Nouryoku(IntNoryoku)
'変数の値変更
Col = Col + 1
'長打決定
'アベレージポイント取得
Avipoint = Cells(Low + 1, Col)
'能力指数Up
IntNoryoku = Cells(Low, Col)
Call NouryokuUp(Karada(1), IntNoryoku, GetFrg, Avipoint)
Cells(Low, Col) = IntNoryoku
'能力指数Down
IntNoryoku = Cells(Low, Col)
Call NouryokuDown(Karada(1), IntNoryoku, GetFrg, Avipoint)
Cells(Low, Col) = IntNoryoku
'能力値決定
If Right(BStyle, 1) = "P" Then
IntNoryoku = IntNoryoku + 10
End If
Cells(Low - 1, Col) = Get_Nouryoku(IntNoryoku)
'変数の値変更
Col = Col + 1
'信頼決定
'アベレージポイント取得
Avipoint = Cells(Low + 1, Col)
'能力指数Up
IntNoryoku = Cells(Low, Col)
Call NouryokuUp(Kokoro(1), IntNoryoku, GetFrg, Avipoint)
Cells(Low, Col) = IntNoryoku
'能力指数Down
IntNoryoku = Cells(Low, Col)
Call NouryokuDown(Kokoro(1), IntNoryoku, , Avipoint)
Cells(Low, Col) = IntNoryoku
'能力値決定
If Right(BStyle, 1) = "P" Then
IntNoryoku = IntNoryoku + 5
End If
Cells(Low - 1, Col) = Get_Sinrai(IntNoryoku, BStyle)
'変数の値変更
Col = Col + 1
'対左決定
'アベレージポイント取得
Avipoint = Cells(Low + 1, Col)
'能力指数Up
IntNoryoku = Cells(Low, Col)
Call NouryokuUp(Kokoro(1), IntNoryoku, GetFrg, Avipoint)
Cells(Low, Col) = IntNoryoku
'能力指数Down
IntNoryoku = Cells(Low, Col)
Call NouryokuDown(Kokoro(1), IntNoryoku, , Avipoint)
Cells(Low, Col) = IntNoryoku
'能力値決定
If Right(BStyle, 1) = "S" Then
IntNoryoku = IntNoryoku + 5
End If
Cells(Low - 1, Col) = Get_KillLeft(IntNoryoku, BStyle)
'変数の値変更
Col = Col + 1
'打撃指数決定
'アベレージポイント取得
Avipoint = Cells(Low + 1, Col)
'能力指数Up
IntNoryoku = Cells(Low, Col)
Call NouryokuUp(Waza(1), IntNoryoku, GetFrg, Avipoint)
Cells(Low, Col) = IntNoryoku
'能力指数Down
IntNoryoku = Cells(Low, Col)
Call NouryokuDown(Waza(1), IntNoryoku, GetFrg, Avipoint)
Cells(Low, Col) = IntNoryoku
'能力値決定
Cells(Low - 1, Col) = Get_Daritu(Cells(Low, Col))
'年齢を加算
Col = Col - 21
Cells(Low - 1, Col) = (Cells(Low - 1, Col)) + 1
If Cells(Low - 1, Col) >= 50 Then
GetFrg = True
End If
Col = Col + 21
'引退フラグ
If GetFrg = True Then
Cells(Low - 1, Col + 1) = "退団"
For i = 1 To 6
Cells(Low - 1, Col + i - 16) = ""
Next i
Else
Select Case k
Case Is <= 16
Cells(Low - 1, Col + 1) = "１軍"
Cells(Low, Col + 1) = k
Case Is <= 34
Cells(Low - 1, Col + 1) = "２軍"
Cells(Low, Col + 1) = k
Case Is <= 39
Cells(Low - 1, Col + 1) = "外人"
Cells(Low, Col + 1) = k
Case Else
Cells(Low - 1, Col + 1) = "新人"
Cells(Low, Col + 1) = k
End Select
End If
Next j
End If
Next k
Exit Function
err:
MsgBox err.Description
Resume Next
End Function
Public Sub 野手移動()
Dim i As Byte
Dim j As Byte '選手数34名
Dim Low As Byte
Dim Col As Byte
Dim movlow As Byte
For i = 1 To 3
'初期設定
Col = 28
Low = 101
For j = 1 To 34
'1軍への移動
If Cells(Low, Col - 4) = "１軍" Then
movlow = 2
'空いている行を探す
Do Until Cells(movlow, Col - 4) = ""
movlow = movlow + 3
Loop
If Low <> movlow Then
'各項目の移動
If movlow < 102 Then
Call 選手移動(movlow, Low, Col)
End If
End If
ElseIf Cells(Low, Col - 4) = "２軍" Then
'2軍への移動
movlow = 50
'空いている行を探す
Do Until Cells(movlow, Col - 4) = ""
movlow = movlow + 3
Loop
If Low <> movlow Then
'各項目の移動
If movlow < 102 Then
Call 選手移動(movlow, Low, Col)
End If
End If
End If
If Low > 3 Then
Low = Low - 3
End If
Next j
Next i
End Sub
Public Function シート内容クリア(SeatName As String)
Sheets(SeatName).Activate
Range("A2:AA139").Select
Selection.ClearContents
End Function
Warning: Undefined variable $url in /home/zakinyan/osusumedorama.com/public_html/wp-content/plugins/download-monitor/src/Logs/WordPressLogItemRepository.php on line 147