長女 はじめて歯が抜けた記念日
2023.2.7
おめでとう！
保育園のお散歩の帰り道にて。
びっくりして少し泣いたとのこと
【ふるさと納税】住所記入ミスったときのメール連絡テンプレ
ふるさと納税に申し込んだが、住所記入誤りにきづいたとき。
■悪いこと
・寄付証明書が届かない！
・返礼品が届かない！
■対処
寄付先の問合せ窓口に連絡して、住所訂正を申し出ましょう。
各種ポータルサイト経由で寄付申込した場合は、ポータルサイトの履歴等から連絡先を確認できることも多いです。
■メールテンプレ
○○市△△町
ふるさと納税担当者様
●●県在住の峯岸と申します。
ふるさと納税での
住所記入ミスのご連絡と訂正のご依頼となります。
■事実情報
20XX年XX月XX日にふるなびポータルサイト経由で
ふるさと納税として寄付を実施しました。
その際、住所（部屋番号）の記入ミスがありました。
・誤）：●●県●●市●●町１－２－３
・正）：●●県●●市●●町１－２－４
■訂正のご依頼
お忙しいところ大変申し訳ございませんが
以下2点ご対応いただけないでしょうか。
・寄付証明証の住所の訂正
・返礼品の送付先住所の訂正
応援する気持ちで寄付したものの
年末年始の大変忙しい時期に
逆に手を煩わせる形となってしまい申し訳ありません。
■申込情報
ポータルサイト：●●
寄付日時：20YY/MM/DD
寄付金額：￥10000
希望返礼品：★
--------------------------
名前：
電話番号：
mail：
--------------------------
2021年12月28日
受付詳細
■宮崎県木城町
K13_0012＜「木城えほんの郷オリジナルえほんセット」～6歳までAセット～おおよそ3～5冊＞
15,000
■千葉県市原市
洗剤 スーパー ナノックス ギフト LSN-50A トップ 洗濯 詰め替え
12,000
2022年01月11日より投稿可能
■鳥取県大山町
MS-02 新鮮朝採れ野菜セット
9,000
2022年01月11日より投稿可能
■大阪府泉佐野市
005A060 【先行予約】ゴールドラッシュ 7本セット とうもろこし
5,000
□熊本県御船町
ご家庭用 熊本ふるさと無洗米14kg 《2022月1月下旬-2月末頃より順次出荷》 熊本県産 無洗米 14kg 精米 10kg以上 ヒノヒカリ使用 御船町
10,00
2022年目標立てる
【英語】
TOEIC730
・1日15分英語の勉強を継続 4日中3日を1セット目標にまずは7回（28日）中6回達成
・単語・文法・リスニング
・英語の映画見る・英語の絵本を読む
・簡単な問題集をたくさんこなす
・英語の読み物本読んでモチベアップ
【資産形成】
不労所得を増やす
・現預金資産率を50％以下に
・ETF/VTI毎月購入
・外国株の割合増やす
ふるさと納税を定期的に。3か月に分けてやる
【仕事】
標準化
ノウハウ共有のプラットフォーム作り
・開発作業
将来展望を考える
チャレンジ！ 「ゼロより良い」
【家庭】
無事平穏 妻を幸せに、子供を幸せに
育休を考えておく
育休ルール見直し・勉強
5人の生活考える 家・車
片づけをこまめに頑張る
断捨離
のんと実家へお泊り会
【プライベート】
phythonを勉強したい
・入門編1冊よむ
・実行環境作る
・なんか作ってみる
パワプロはほどほどに
【健康】
奥歯を抜く
足の爪を直したい
夜12時には作業やめて寝る支度を
自己肯定感 夜寝る前にその日起きたいいことを３つ唱えるといいらしい
【不動産投資】ワンルームマンション投資
2本の動画を見て、やっぱりワンルームマンション投資は手を出さないでおこう
と決意した話。
■経過
・現預金の割合が増えてきたので、リスク資産に割り振ろうと思うも株式・投信に寄せすぎるのはコワイ、精神衛生上よろしくない、ということで悩んでいた
・不動産投資に目を向ける
・不動産投資業者のセミナー聞いてみる
・いわれるがまま買いそうになるも高額な買い物なので、とブレーキをかける
・半年ほど本を読んだり、不動産販売業者のセミナー聞いてみたり
・本業あるサラリーマンで不動産投資するなら、ワンルームマンション投資で手堅くいくのありでは、と思い始める。周りはやめておけ、というけど本当にそうなの、という視点で考えてみる。銀行預金×インフレで目減りするよりよっぽどいいじゃんという考え
・不動産投資販売業者との接触再開。なごみ・日本財託
・物件をたくさん紹介してもらう
・いろいろシミュレーションして収益計算してみたが、どうも20年たっても利益出るかどうか怪しい、、
■ＹＯＵＴＵＢＥみた
・もふもふ不動産
https://www.youtube.com/watch?v=4qzO8ZmBrRU
ワンルームマンション投資やるならここを確認せよ
１．収益性、２．売却額、３．購入額の適切さ、４．買う目的は
１，４は何とか話せる、３が全くダメ。
購入しようとしている物件が、適正価格いくらで市場価格に対してどうで、対して利益をいくら乗せて販売業者が販売しようとしているか、を語れるようでないと、買った瞬間損をすることになる。また知らずに買ってものちのち絶対後悔することになる
・さらに両学長の動画
https://www.youtube.com/watch?v=vnJXpaUjz4I&t=860s
自分はまさにスズメになりかけてたと思い知らされる
「物件の適正価格」の目利きが自分自身でできるようになるまでは、購入検討は控えることを決意
もふさんでも最初の物件買うまで1年、じっくり物件の物色して勉強したみたいだし。
一度不動産投資関連の本読み漁りは休憩するけど今後やっておきたいこと
・五十嵐みほの本読んでみる
・成功している不動産投資関係者とパスを作りたいがハードルは高そう
・市場価格の適正性を目利きできるように、物件情報は今後もアンテナ張っておきたい
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
ケーキ屋さんの紙袋
子供のイヤイヤが激しく、少々疲れたのでたまには甘いものを、と駅近くのケーキ屋さんでケーキを買ったんですが
「紙袋22円になりますが、いかがですか？」と聞かれまして。
レジ袋有料化の流れは特に否定しないんですが、ケーキ屋でケーキ買って紙袋持たずにどうやって持って帰るんですか。。箱のまま手で持って帰れと？
と、なんだかイラっとしました。22円という値段も高い。
Logicool M590 Unifyingレシーバーが認識しなくなった場合の解決法
もともとUnifying接続していたマウスをBluetooth接続しようと、接続設定どおりに設定して、無事Bluetooth接続できるようになったのですが、今度はなぜかUnifyingレシーバ
を認識しないようになってしまいました。。
https://nasunoblog.blogspot.com/2012/12/logicool-unifying.html
こちらの情報をもとに解決しました。
備忘録
■故障時の状況
・Bluetooth接続はできている
・PCがUnifying接続のレシーバーをどうも認識していない
・Unifyingレシーバとマウス間のペアリング設定は変えていない（ペアリングされていそう）
■やったこと
「Unifying受信機のペアリングを一度削除→再ペアリング」
・LogicoolOptionの立ち上げ
→「デバイスの追加」ボタン
→「高度なUNIFYINGアプリ」ボタン
→別ウィンドウ立ちあがる
→「詳細」ボタン
→該当のマウスを選択して「ペアリングを解除」
→同様の要領で、「新しいデバイスをペアリング」
これでうまくペアリングでき、マウスをUnifyingレシーバ経由で使えるようになりました！
