娘２人のパパが育休3か月とりました 2019

育休3か月ほど取得しました。育休に関連した出来事や、思うこと、時々自分向けのメモ　をつらつらと。

VBAメモ

Private Sub CloseButton3_Click()
'機能:ユーザーフォームを閉じる
Unload UserForm1
End Sub
Private Sub ClearButton_Click()
'機能：テキストボックス内クリア
UserForm1.TextBox1.Value = ""
End Sub


Private Sub CommandButton1_Click()
'機能：選択範囲の表データを読み取り、HTMLを作成する
'in：選択したデータ
'out：html　出力場所はテキストエリア

'シートから選択範囲を取得
'参照：http://officetanaka.net/excel/vba/tips/tips111.htm
Dim left, up, right, down As Integer '選択範囲を表す変数
Dim c As String

left = Selection(1).Column '左列
up = Selection(1).row '上行
right = Selection(Selection.Count).Column '右列
down = Selection(Selection.Count).row '下行

For i = 0 To down - up
UserForm1.TextBox1.Value = UserForm1.TextBox1.Value + "<tr>"
UserForm1.TextBox1.Value = UserForm1.TextBox1.Value + vbNewLine
For j = 0 To right - left
c = Cells(up + i, left + j)

UserForm1.TextBox1.Value = UserForm1.TextBox1.Value + "<td>" & c & "</td>"
UserForm1.TextBox1.Value = UserForm1.TextBox1.Value + vbNewLine
Next j
UserForm1.TextBox1.Value = UserForm1.TextBox1.Value + "</tr>"
UserForm1.TextBox1.Value = UserForm1.TextBox1.Value + vbNewLine

Next i
'ラベル設定
UserForm1.Label1.Caption = "HTML"

End Sub

Private Sub CommandButton10_Click()
'試合情報HTML作成ボタン
'試合情報のHTMLを作成する機能
'"試合情報"を選択した状態で呼び出す

'テキストボックス内クリア
UserForm1.TextBox1.Value = ""

'シートから選択範囲を取得
'参照：http://officetanaka.net/excel/vba/tips/tips111.htm
Dim col, row As Integer '選択範囲を表す変数
Dim team, game_class, opposition, date_, location, start, whether As String

col = ActiveCell.Column
row = ActiveCell.row

If ThisWorkbook.ActiveSheet.Name <> "打撃成績入力" Then
MsgBox ("このボタンは打撃成績シートで有効です")
Exit Sub
End If


If Cells(row, col) <> "試合情報" Then
MsgBox ("試合情報のHTMLを作成するボタンです。該当の試合の""試合情報""を選択した状態でこのボタンを押してください")
Exit Sub
End If

team = Cells(row, col + 1)
game_class = Cells(row + 1, col + 1)
opposition = Cells(row + 2, col + 1)
date_ = Cells(row + 3, col + 1)
location = Cells(row + 1, col + 3)
start = Cells(row + 2, col + 3)
whether = Cells(row + 3, col + 3)

'テキストエリアに試合情報HTML出力
UserForm1.TextBox1.Value = UserForm1.TextBox1.Value + "<h2>" & game_class & "</h2>" + vbNewLine
UserForm1.TextBox1.Value = UserForm1.TextBox1.Value + "<h3>" & team & " vs " & opposition & "</h3>" + vbNewLine
UserForm1.TextBox1.Value = UserForm1.TextBox1.Value + "<h3>" & date_ & "</h3>" + vbNewLine
UserForm1.TextBox1.Value = UserForm1.TextBox1.Value + "会場：" & location & "<br>" + vbNewLine
UserForm1.TextBox1.Value = UserForm1.TextBox1.Value + "試合開始：" & start & "<br>" + vbNewLine
UserForm1.TextBox1.Value = UserForm1.TextBox1.Value + "天候：" & whether & "<br><br>" + vbNewLine

'ラベル設定
UserForm1.Label1.Caption = "試合情報_HTML"




End Sub

Private Sub CommandButton14_Click()
'試合情報HTML作成ボタン
'スコアボードのHTMLを作成する機能
'スコアボード中の"team"を選択した状態で呼び出す

'テキストボックス内クリア
UserForm1.TextBox1.Value = ""

'シートから選択範囲を取得
'参照：http://officetanaka.net/excel/vba/tips/tips111.htm
Dim col, row As Integer '選択範囲を表す変数
Dim team1, team2 As String

col = ActiveCell.Column
row = ActiveCell.row

team1 = Cells(row + 1, col)
team2 = Cells(row + 2, col)


If ThisWorkbook.ActiveSheet.Name <> "打撃成績入力" Then
MsgBox ("このボタンは打撃成績シートで有効です")
Exit Sub
End If


If Cells(row, col) <> "team" Then
MsgBox ("スコアボードのHTMLを作成するボタンです。\nスコアボードの""team""を選択した状態でこのボタンを押してください")
Exit Sub
End If
'youtubeリンク版もつくる　フラグで判定

'テキストエリアにスコアボードHTML出力
UserForm1.TextBox1.Value = UserForm1.TextBox1.Value + "<table width=""420"" border=""1"" cellpadding=""1"" cellspacing=""1"">" + vbNewLine

UserForm1.TextBox1.Value = UserForm1.TextBox1.Value + "<tr align=""center"" bgcolor=""#A7E0BA"">" + vbNewLine
UserForm1.TextBox1.Value = UserForm1.TextBox1.Value + "<th>team</th>" + vbNewLine
UserForm1.TextBox1.Value = UserForm1.TextBox1.Value + "<th>1</th>" + vbNewLine
UserForm1.TextBox1.Value = UserForm1.TextBox1.Value + "<th>2</th>" + vbNewLine
UserForm1.TextBox1.Value = UserForm1.TextBox1.Value + "<th>3</th>" + vbNewLine
UserForm1.TextBox1.Value = UserForm1.TextBox1.Value + "<th>4</th>" + vbNewLine
UserForm1.TextBox1.Value = UserForm1.TextBox1.Value + "<th>5</th>" + vbNewLine
UserForm1.TextBox1.Value = UserForm1.TextBox1.Value + "<th>6</th>" + vbNewLine
UserForm1.TextBox1.Value = UserForm1.TextBox1.Value + "<th>7</th>" + vbNewLine
UserForm1.TextBox1.Value = UserForm1.TextBox1.Value + "<th><strong>R</strong></th>" + vbNewLine
UserForm1.TextBox1.Value = UserForm1.TextBox1.Value + "<th>H</th>" + vbNewLine
UserForm1.TextBox1.Value = UserForm1.TextBox1.Value + "</tr>" + vbNewLine + vbNewLine


UserForm1.TextBox1.Value = UserForm1.TextBox1.Value + "<tr align=""center"">" + vbNewLine
UserForm1.TextBox1.Value = UserForm1.TextBox1.Value + "<td>" & team1 & "</td>" + vbNewLine
UserForm1.TextBox1.Value = UserForm1.TextBox1.Value + "<td>" & Cells(row + 1, col + 1) & "</td>" + vbNewLine
UserForm1.TextBox1.Value = UserForm1.TextBox1.Value + "<td>" & Cells(row + 1, col + 2) & "</td>" + vbNewLine
UserForm1.TextBox1.Value = UserForm1.TextBox1.Value + "<td>" & Cells(row + 1, col + 3) & "</td>" + vbNewLine
UserForm1.TextBox1.Value = UserForm1.TextBox1.Value + "<td>" & Cells(row + 1, col + 4) & "</td>" + vbNewLine
UserForm1.TextBox1.Value = UserForm1.TextBox1.Value + "<td>" & Cells(row + 1, col + 5) & "</td>" + vbNewLine
UserForm1.TextBox1.Value = UserForm1.TextBox1.Value + "<td>" & Cells(row + 1, col + 6) & "</td>" + vbNewLine
UserForm1.TextBox1.Value = UserForm1.TextBox1.Value + "<td>" & Cells(row + 1, col + 7) & "</td>" + vbNewLine
UserForm1.TextBox1.Value = UserForm1.TextBox1.Value + "<td><strong>" & Cells(row + 1, col + 8) & "</strong></td>" + vbNewLine
UserForm1.TextBox1.Value = UserForm1.TextBox1.Value + "<td>" & Cells(row + 1, col + 9) & "</td></tr>" + vbNewLine + vbNewLine

UserForm1.TextBox1.Value = UserForm1.TextBox1.Value + "<tr align=""center"">" + vbNewLine
UserForm1.TextBox1.Value = UserForm1.TextBox1.Value + "<td>" & team2 & "</td>" + vbNewLine
UserForm1.TextBox1.Value = UserForm1.TextBox1.Value + "<td>" & Cells(row + 2, col + 1) & "</td>" + vbNewLine
UserForm1.TextBox1.Value = UserForm1.TextBox1.Value + "<td>" & Cells(row + 2, col + 2) & "</td>" + vbNewLine
UserForm1.TextBox1.Value = UserForm1.TextBox1.Value + "<td>" & Cells(row + 2, col + 3) & "</td>" + vbNewLine
UserForm1.TextBox1.Value = UserForm1.TextBox1.Value + "<td>" & Cells(row + 2, col + 4) & "</td>" + vbNewLine
UserForm1.TextBox1.Value = UserForm1.TextBox1.Value + "<td>" & Cells(row + 2, col + 5) & "</td>" + vbNewLine
UserForm1.TextBox1.Value = UserForm1.TextBox1.Value + "<td>" & Cells(row + 2, col + 6) & "</td>" + vbNewLine
UserForm1.TextBox1.Value = UserForm1.TextBox1.Value + "<td>" & Cells(row + 2, col + 7) & "</td>" + vbNewLine
UserForm1.TextBox1.Value = UserForm1.TextBox1.Value + "<td><strong>" & Cells(row + 2, col + 8) & "</strong></td>" + vbNewLine
UserForm1.TextBox1.Value = UserForm1.TextBox1.Value + "<td>" & Cells(row + 2, col + 9) & "</td></tr>" + vbNewLine + vbNewLine

UserForm1.TextBox1.Value = UserForm1.TextBox1.Value + "</tr>" + vbNewLine + "</table>"

End Sub

Private Sub CommandButton15_Click()
'=======================================================
'打撃成績入力シートの打率算出列に個人の通算打率を表示する
'=======================================================
'=前提条件=
'打撃成績入力後、個人打撃成績反映後に起動すること
'算出対象の打率セルが選択されていることとする
'選択した打率セルの左となりに選手名が入力されていること
'「打撃成績シート」の対象選手の通算成績行4列目に「合計」が記入されていること
'「打撃成績シート」の打率列が7行目であること

'=処理イメージ=
'選択セルの左の選手名を打撃成績シートから探索する
' 見つかる：対象選手の打率を打撃成績入力シートの打率列に出力する
'　見つからない：下記メッセージをUserFormに出力し処理を続行
'　　msg：対象選手：xxが個人打撃成績シートに存在しません
'処理が完了したら、処理完了した旨、UserFormに出力する

'=======================================================
'--------
'入力制限
'下記条件の場合入力対象外として、msgを表示
'・条件1：対象シートが「打撃成績入力シート」でない
'・条件2：選択したセルがC列(打率列)でない
'出力msg
'「通算打率算出処理です。打撃成績入力シートの算出対象打率列を選択してください」
'--------
If ThisWorkbook.ActiveSheet.Name <> "打撃成績入力" Then
MsgBox ("このボタンは打撃成績入力シートで有効です")
Exit Sub
End If
If Selection(1).Column <> 3 Then
MsgBox ("通算打率算出処理です。打撃成績入力シートの算出対象打率列を選択してください")
Exit Sub
End If

'--------
'通算打率表示処理
'--------
Dim left, up, right, down As Integer '選択範囲を表す変数
Dim player As String '選手名を入れる変数

left = Selection(1).Column '左列
up = Selection(1).row '上行
right = Selection(Selection.Count).Column '右列
down = Selection(Selection.Count).row '下行

'選択したセルの個数をカウント
Dim a As Integer
a = Selection.Rows.Count

Dim i, j, k As Integer '繰り返し処理用変数




For i = 1 To a
'選手名を取得
player = Cells(up + i - 1, 2)
player = "【" & player & "】" '選手名加工
'''''''''''''''''''''''''''''''''''''''''''''''''''Cells(1, 26) = player
'シートを選択
Sheets("打撃成績").Activate
'打撃成績シートから対象選手を探索し、打率をコピー
For j = 1 To 500
If player = Cells(j, 2) Then '選手が見つかったら以下の処理を実施
'4列目にいる「合計」を探す
For k = 1 To 20
If Cells(j + k, 4) = "合計" Then
Cells(j + k, 7).Copy

'Activveシート変更
Sheets("打撃成績入力").Activate
Cells(up + i - 1, 3).Select 'コピー先選手の打率列(3列)を選択
ActiveCell.PasteSpecial Paste:=xlPasteValuesAndNumberFormats
k = 20 ' ループ抜ける
End If
Next k
j = 500 'ループを抜けて、次の選手に処理を進める

End If

Next j
'500行見て選手が打撃成績シートにいなかった場合選手が存在しない場合
'UserForm1.TextBox1.Value = UserForm1.TextBox1.Value + player + "が個人打撃シートに存在しません"

Next i
End Sub

Private Sub CommandButton2_Click()
'打撃成績HTML作成ボタン
'機能：成績表データを読み取り、HTMLを作成する
'in：選択したデータ
'out：html　出力場所はテキストエリア


'テキストボックス内クリア
UserForm1.TextBox1.Value = ""

'シートから選択範囲を取得
'参照：http://officetanaka.net/excel/vba/tips/tips111.htm
Dim left, up, right, down As Integer '選択範囲を表す変数
Dim c As String
Dim color As String
Dim colorFlg As Boolean

left = Selection(1).Column '左列
up = Selection(1).row '上行
right = Selection(Selection.Count).Column '右列
down = Selection(Selection.Count).row '下行


'成績データhtml出力 セルごとに処理
For i = 0 To down - up '「打撃成績シート」の対象選手の通算成績行に「合計」が記入されていること
UserForm1.TextBox1.Value = UserForm1.TextBox1.Value + " <tr bgcolor=""" + color + """>" + vbNewLine
For j = 0 To right - left '名前(氏名)をチェック範囲から外すためj=8から検索スタート
c = Cells(up + i, left + j) 'セルの値を取得

'*-*-*-*打点チェック機能*-*-*-*
'機能:文字列中に①or②or③or④があればそのセルの文字列を太字にする
'詳細:文字列の前後に<b> </b>を加える
If InStr(1, c, "①", vbBinaryCompare) > 0 Or InStr(1, c, "②", vbBinaryCompare) > 0 _
Or InStr(1, c, "③", vbBinaryCompare) > 0 Or InStr(1, c, "④", vbBinaryCompare) > 0 Then
c = "<b>" + c + "</b>"
End If
'*-*-*-*安打チェック機能*-*-*-*
'機能:文字列中に"安"または"２","３","本"があればその文字列を赤字にする
'詳細:文字列の前後に<font color="ff0000"> </font>を加える
If InStr(1, c, "安", vbBinaryCompare) > 0 Or InStr(1, c, "２", vbBinaryCompare) > 0 _
Or InStr(1, c, "３", vbBinaryCompare) > 0 Then
c = "<font color=""ff0000"">" + c + "</font>"
End If
'打率の表示形式を.000とするため、2列目のみチェック
If j = 2 Then
UserForm1.TextBox1.Value = UserForm1.TextBox1.Value + "<td>" & Format(c, ".000") & "</td>" + vbNewLine
Else
UserForm1.TextBox1.Value = UserForm1.TextBox1.Value + "<td>" & c & "</td>" + vbNewLine
End If
'合計行の出力
If i = down - up And j = 11 Then
UserForm1.TextBox1.Value = UserForm1.TextBox1.Value + "<td colspan=7></td><!--colspan=イニング数-->" + vbNewLine
'ループ抜ける
j = 20
End If

'切りのいい箇所で一旦改行
If j = 6 Or j = 10 Then
UserForm1.TextBox1.Value = UserForm1.TextBox1.Value + vbNewLine
End If
Next j

UserForm1.TextBox1.Value = UserForm1.TextBox1.Value + "</tr>" + vbNewLine + vbNewLine

'一行毎に変わる背景色の設定
If colorFlg = False Then
color = "#D0FEFF"
colorFlg = True
Else
color = ""
colorFlg = False
End If
Next i
'ラベル設定
UserForm1.Label1.Caption = "打撃成績_HTML"

End Sub

 

Private Sub CommandButton3_Click()
'スコアボードボタン
'機能：選択範囲の表データを読み取り、スコアボードを作成する
'in：選択したデータ
'out：html　出力場所は...

'シートから選択範囲を取得
Dim left, up, right, down As Integer '選択範囲を表す変数
Dim c As String

left = Selection(1).Column '左列
up = Selection(1).row '上行
right = Selection(Selection.Count).Column '右列
down = Selection(Selection.Count).row '下行

For i = 0 To down - up
UserForm1.TextBox1.Value = UserForm1.TextBox1.Value + "<tr>"
UserForm1.TextBox1.Value = UserForm1.TextBox1.Value + vbNewLine
For j = 0 To right - left
c = Cells(up + i, left + j)
'*-*-*-*諸々チェック機能*-*-*-*
'バイン→太字
If InStr(1, c, "バイン", vbBinaryCompare) > 0 Then
c = "<strong>" + c + "</strong>"
End If
'1行目は<th>タグ &背景色
If i = 0 Then
UserForm1.TextBox1.Value = UserForm1.TextBox1.Value + "<th>" & c & "</th>" + vbNewLine
Else
UserForm1.TextBox1.Value = UserForm1.TextBox1.Value + "<td>" & c & "</td>" + vbNewLine
End If
Next j
UserForm1.TextBox1.Value = UserForm1.TextBox1.Value + "</tr>" + vbNewLine + vbNewLine
Next i
'ラベル設定
UserForm1.Label1.Caption = "スコアボード_HTML"

End Sub

Private Sub CommandButton4_Click()
'スタメンボタン
'機能：選択範囲の表データを読み取り、スタメン表を作成する
'in：選択したデータ
'out：html　出力場所は...

'シートから選択範囲を取得
Dim left, up, right, down As Integer '選択範囲を表す変数
Dim c As String

left = Selection(1).Column '左列
up = Selection(1).row '上行
right = Selection(Selection.Count).Column '右列
down = Selection(Selection.Count).row '下行

For i = 0 To down - up
UserForm1.TextBox1.Value = UserForm1.TextBox1.Value + "<tr>"
UserForm1.TextBox1.Value = UserForm1.TextBox1.Value + vbNewLine
For j = 0 To right - left
c = Cells(up + i, left + j)
'*-*-*-*諸々チェック機能*-*-*-*
'バイン→太字
If InStr(1, c, "バイン", vbBinaryCompare) > 0 Then
c = "<strong>" + c + "</strong>"
End If
'1行目は<th>タグ &背景色
If i = 0 Then
UserForm1.TextBox1.Value = UserForm1.TextBox1.Value + "<th>" & c & "</th>" + vbNewLine
Else
UserForm1.TextBox1.Value = UserForm1.TextBox1.Value + "<td>" & c & "</td>" + vbNewLine
End If
Next j
UserForm1.TextBox1.Value = UserForm1.TextBox1.Value + "</tr>" + vbNewLine + vbNewLine
Next i
'ラベル設定
UserForm1.Label1.Caption = "スタメン_HTML"
End Sub

 

Private Sub CommandButton6_Click()
'Copyボタン
'機能：テキストエリア中文字列をクリップボードにコピーする
'用途：テキストエリアにHTMLを出力した後、HTML貼り付けるために使用
With TextBox1
.SetFocus
.SelStart = 0
.SelLength = Len(TextBox1)
.Copy
End With

End Sub

Private Sub CommandButton7_Click()
'個人打撃成績反映ボタン
'機能：「打撃成績入力」シートに記載した１試合分のデータをコピーし、
' 「打撃成績」シートに個人ごとに反映する
'IN: 打率列～7回列まで選択 '一試合分
'OUT:個人打撃成績に一行(1試合分)追加

'選択範囲の情報を取得
Dim left, up, right, down As Integer '選択範囲を表す変数
Dim c As String

left = Selection(1).Column '左列
up = Selection(1).row '上行
right = Selection(Selection.Count).Column '右列
down = Selection(Selection.Count).row '下行

a = down - up + 1 '選択した選手数＝繰り返し回数

Dim line As Integer '名前みつけたら行数を記憶
line = 1

'選手数分繰り返し
For h = 1 To a


'選手名を取得
player = Cells(up + h - 1, 2)
player = "【" & player & "】" '選手名加工

'対象範囲をコピー (選手一人分の1試合データ) 3列目から19列目
Range(Cells(up + h - 1, 3), Cells(up + h - 1, 19)).Copy

Sheets("打撃成績").Select
For i = 1 To 500
If player = Cells(i, 2) Then '選手が見つかったら以下の処理を実施
For j = 1 To 20 '年間20試合を越えるとエラーとなります
If Cells(i + j, 8) = "" Then '打数列が空白ならば、
line = i + j
Cells(line, 7).Select 'コピー先選手の打率列(7列)を選択
ActiveCell.PasteSpecial Paste:=xlPasteValuesAndNumberFormats
'打撃成績から空白セルを削除
For k = 0 To 6
If Cells(line, 17 + k) = "" Then
Cells(line, 17 + k).Delete shift:=xlToLeft
End If
Next k
For k = 0 To 6
If Cells(line, 17 + k) = "" Then
Cells(line, 17 + k).Delete shift:=xlToLeft
End If
Next k

j = 20 'ループを抜ける
End If
Next j
UserForm1.TextBox1.Value = UserForm1.TextBox1.Value + player
i = 400 'ループを抜ける
End If
Next i

Sheets("打撃成績入力").Select
Next h
' コピーモード解除(Escキー)
Application.CutCopyMode = False

UserForm1.TextBox1.Value = UserForm1.TextBox1.Value + "個人成績への反映が完了しました"
End Sub

Private Sub CommandButton8_Click()

Load UserForm2
UserForm2.Show
End Sub

Private Sub CommandButton9_Click()

'個人打撃成績反映2ボタン
'機能：「打撃成績入力」シートに記載した試合情報のデータをコピーし、
' 「打撃成績」シートに個人ごとに反映する
'IN:試合情報
'OUT:個人打撃成績に一行(1試合分)追加

'選択範囲の情報を取得
Dim left, up, right, down As Integer '選択範囲を表す変数

Dim game_type As String '試合種別
Dim opposition As String '対戦相手
Dim schedule As String '日にち
Dim location As String '試合会場
Dim start As String '試合開始
Dim weather As String '天候


left = Selection(1).Column '左列
up = Selection(1).row '上行
right = Selection(Selection.Count).Column '右列
down = Selection(Selection.Count).row '下行

game_type = Cells(left, up)
opposition = Cells(left, up + 1)
schedule = Cells(left, up + 2)
location = Cells(left + 1, up)
start = Cells(left + 1, up + 1)
weather = Cells(left + 1, up + 2)

'########### 処理部 ############
If ThisWorkbook.ActiveSheet.Name <> "打撃成績入力" Then
MsgBox ("このボタンは打撃成績シートで有効です")
Exit Sub
End If


UserForm1.TextBox1.Value = "個人成績への反映が完了しました"

End Sub

Private Sub TextBox1_Change()

End Sub


Private Sub UserForm_Click()

End Sub

 

 

 

 

 

Private Sub CommandButton1_Click()
'Closeボタン
'機能:ユーザーフォームを閉じる
Unload UserForm2
End Sub

Private Sub CommandButton2_Click()
'「値をコピー」ボタン
'セル(5,2)～セル(20.13)まで16人分の成績データをコピーする（値をコピー）
'対象範囲をコピー (選手一人分の1試合データ) 3列目から19列目
Range(Cells(5, 2), Cells(20, 13)).Copy

Cells(25, 18).Select 'コピー先選手の打率列(7列)を選択
ActiveCell.PasteSpecial Paste:=xlPasteValuesAndNumberFormats

Cells(45, 18).Select 'コピー先選手の打率列(7列)を選択
ActiveCell.PasteSpecial Paste:=xlPasteValuesAndNumberFormats

Cells(65, 18).Select 'コピー先選手の打率列(7列)を選択
ActiveCell.PasteSpecial Paste:=xlPasteValuesAndNumberFormats

Cells(85, 18).Select 'コピー先選手の打率列(7列)を選択
ActiveCell.PasteSpecial Paste:=xlPasteValuesAndNumberFormats

Cells(105, 18).Select 'コピー先選手の打率列(7列)を選択
ActiveCell.PasteSpecial Paste:=xlPasteValuesAndNumberFormats

Cells(125, 18).Select 'コピー先選手の打率列(7列)を選択
ActiveCell.PasteSpecial Paste:=xlPasteValuesAndNumberFormats

Cells(145, 18).Select 'コピー先選手の打率列(7列)を選択
ActiveCell.PasteSpecial Paste:=xlPasteValuesAndNumberFormats

Cells(165, 18).Select 'コピー先選手の打率列(7列)を選択
ActiveCell.PasteSpecial Paste:=xlPasteValuesAndNumberFormats

Cells(185, 18).Select 'コピー先選手の打率列(7列)を選択
ActiveCell.PasteSpecial Paste:=xlPasteValuesAndNumberFormats

Cells(205, 18).Select 'コピー先選手の打率列(7列)を選択
ActiveCell.PasteSpecial Paste:=xlPasteValuesAndNumberFormats

' コピーモード解除(Escキー)
Application.CutCopyMode = False

End Sub

Private Sub CommandButton3_Click()
'機能：選択範囲の表データを読み取り、HTMLを作成する（rankシート用）
'in：選択したデータ
'out：html　出力場所はテキストエリア

'シートから選択範囲を取得
'参照：http://officetanaka.net/excel/vba/tips/tips111.htm
Dim left, up, right, down As Integer '選択範囲を表す変数
Dim c As String
Dim color As String
Dim colorFlg As Boolean

left = Selection(1).Column '左列
up = Selection(1).row '上行
right = Selection(Selection.Count).Column '右列
down = Selection(Selection.Count).row '下行

colorFlg = False

For i = 0 To down - up
UserForm2.TextBox1.Value = UserForm2.TextBox1.Value + " <tr bgcolor=""" + color + """>"
UserForm2.TextBox1.Value = UserForm2.TextBox1.Value + vbNewLine
For j = 0 To right - left
c = Cells(up + i, left + j)
'打率の表示形式を.000とするため、2列目のみチェック
If j = 2 Then
UserForm2.TextBox1.Value = UserForm2.TextBox1.Value + "<td>" & Format(c, ".000") & "</td>" + vbNewLine
Else

UserForm2.TextBox1.Value = UserForm2.TextBox1.Value + "<td>" & c & "</td>"
UserForm2.TextBox1.Value = UserForm2.TextBox1.Value + vbNewLine
End If
Next j
UserForm2.TextBox1.Value = UserForm2.TextBox1.Value + "</tr>"
UserForm2.TextBox1.Value = UserForm2.TextBox1.Value + vbNewLine

'一行毎に変わる背景色の設定
If colorFlg = False Then
color = "#D0FEFF"
colorFlg = True
Else
color = ""
colorFlg = False
End If


Next i

End Sub

Private Sub TextBox1_Change()

End Sub