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