アウトドアブランド
アウトドアブランド
日本
中部
- スノーピーク * Snow Peak (snow peak / 新潟県燕三条)
- キャプテンスタッグ|アウトドア用品総合ブランド (CAPTAIN STAG [パール金属株式会社] / 新潟県三条市)
- ユニフレーム アウトドア用品総合メーカー (uniflame / 新潟県燕三条)
関東
- 登山靴のキャラバン公式サイト – 株式会社キャラバン (Caravan [靴メイン] / 東京都豊島区)
- ogawa | テントはogawa (キャンパルジャパン [テントメイン] / 東京都江東)
近畿
- モンベル - アウトドア総合ブランド (mont-bell / 大阪市西区)
- SOTO | OutDoor Gear (SOTO [新富士バーナー] / 愛知県蒲郡市)
- 国産アウトドアブランド 株式会社ファイントラック(finetrack) (finetrack / 兵庫県神戸市)
海外
アメリカ
- アウトドア用品のコロンビアスポーツウェア公式通販サイト (Columbia / オレゴン州)
- パタゴニア アウトドアウェア (patagonia)
- MSR〜テント、ガソリンストーブ、スノーシュー、浄水器〜 | 株式会社モチヅキ (MSR / ワシントン州シアトル)
- コールマン|Coleman (Coleman / オクラホマ州)
- グレゴリー(GREGORY)公式通販 (GREGORY [バックパックがメイン] / 南カリフォルニア)
- KEEN 公式通販 | ご注文から30日以内の返品無料 (KEEN / オレゴン州ポートランド)
- LODGE(ロッジ)|公式ブランドサイト (LODGE [鋳鉄製品がメイン] / テネシー州のサウス・ピッツバーグ)
- Danner | ダナー オフィシャルサイト (Danner [アウトドアブーツ] / オレゴン州ポートランド)
- JETBOIL(ジェットボイル)|公式ブランドサイト (JETBOIL / アメリカ?)
カナダ
Twinings Darjeeling Tea
最近はコーヒーをメインで飲むようになっているけど、以前は紅茶がメインだった。
その名残で、今も定期的に購入しているのが Twinings のダージリン。
普段は袋で買っていたのだけれど、気まぐれを起こして缶で買ってみた。
このダージリンは、袋と缶とで茶葉のグレードが違う?
ブランドとしてのグレードが違う?
左側のように、ペコー的なものを想像してたんだけど、缶の中身はファニングスかダストに見える。
ペコーとかファニングス、ダストについては、こちらを参照してほしい。
www.rakuten.ne.jp
グレードと書いてあるけど、それぞれ向く抽出方法が違う。なので、品質というよりは好みの使い方をすればよいかと。
いつも購入しているタイプの袋は Darjeeling Extra と書いてあるけど、缶の方は無いんだよね。
1杯分 3g に、熱湯 140ml を入れて4分の蒸し時間。
まぁ、渋みがきつく感じるので、大体 2 分くらいで蒸し時間を終わらせているけど。
この辺は個人の好みの範疇。
缶のほうは、完全に細切れ。
1杯分 3g に、熱湯 140ml を入れて4分の蒸し時間。
茶葉のサイズが違うのに抽出時間が同じとか、おかしくない!?
1mm あるかどうか……という感じなので、本来ならティーバッグに使うようなグレードのもののように見えるんだけど。
いつも飲んでる方を、実際に抽出してみたところ。
葉っぱは、キレイに開いてくれている。
トワイニング といったら、これだよね。
次に、缶のほうを。
缶のほうを抽出してみたところ。
量(軽量スプーン1.5)や抽出時間(2分)は同じだけど、やっぱり渋い。
失敗した。
説明書の読み比べを。
うん、書いてある淹れ方は同じ。
ちなみの、片岡物産はインドからトワイニングブランドを輸入している会社で、トワイニング・ジャパンはトワイニングと片岡物産の合弁会社のこと。
モノとしては、中身は同じはずだったんだけどな。
Wake On LAN 起動設定
購入した PC の Wake On LAN 設定方法
購入した PC は、適当に Amazon で選んだ次の PC
UフォレストPC 第9世代 Core i7搭載ゲーミングデスクトップパソコン
- CPU Core i7 9700F
- メモリ8GB
- SSD240GB
- HDD1TB
- DVDマルチドライブ
- GTX1660
- OS Windows10
(2019秋モデルver2.10【ブラック Windows10単品】)
こちらを Wake On LAN で遠隔起動するための設定。
Wake On LAN とは?
事前に設定されたパソコンは、ネットワークアダプターに特殊なコマンドを受信すると OS を起動する。
今回は、常時起動している Raspberry pi からリモートで起動させる設定を行う。
(自宅ルータでブロードキャストアドレスに変換させる方法等もあるけど、すでに用意している環境を利用)
メリットとしては、消費電力の高い Windows 10 PC を、必要な時にリモートで起動してアクセスできるようになること。
Raspberry pi は非常に消費電力が低いので、外出時の不要な消費電力が抑えられるようになる。
【注意】
今回の環境は、事前に internet から Raspbian へリモート接続(SSH および OpenVPN)できるように DynamicDNS も含めて設定済み。
(internet から Windows 10 に直接 RDP できるようにはしていない)
家庭用ルータに穴をあける必要があるので、セキュリティ対策はきちんと行うこと。
PC 側
マザーボードと Windows 10 側で、いくつか設定項目がある。
設定前に、キーボード、マウス、ディスプレイ、ネットワークケーブル、電源を繋いでおくこと。
以下、手順。
UEFI (Unified Extensible Firmware Interface)
まずは、マザボの情報から。
ASLock H310CM-HDV/M のようだ。
https://support.ask-corp.jp/hc/ja/articles/360037025814--Z370M-Pro4-Wake-On-Lan%E3%81%AE%E8%A8%AD%E5%AE%9A%E6%96%B9%E6%B3%95%E3%82%92%E6%95%99%E3%81%88%E3%81%A6%E4%B8%8B%E3%81%95%E3%81%84-
このへん を参考に、設定してみた。
有用な情報を公開いただき、ありがとうございます。
まず、PC の電源を入れて UEFI インフォメーション画面で F2 キーを押す。
UEFI 画面に入ったら、次のメニューから設定を変更・確認しておく。
Advanced Mode > Advanced > ACPI Configuration > PCIE Devices Power On > Enabled
Advanced Mode > Advanced > ACPI Configuration > I219 LAN Power On > Enabled
Advanced Mode > Advanced > Chipset Configuration > Deep Sleep > Disabled
Windows 10
ネットワークアダプター
「スタート」を右クリックして、デバイスマネージャーを起動する。
ネットワークアダプターから対象アダプターのドライバーを更新しておく。
これは「ドライバーソフトウェアの最新版を自動検索」でインストールして良い。
次に、プロパティを開く。
「詳細設定」タブを選んで、「省電力イーサネット」があればオフにする。
同じく「詳細設定」タブで「ウェイク・オン・マジックパケット」「ウェイク・オン・パターン・マッチ」等を「有効」にする。
この辺の設定はドライバーのバージョンで変わるので、その都度判断するしかない。
次に「電源の管理」タブを選んで、「Magic Packet でのみ、コンピューターのスタンバイ状態を解除できるようにする」にチェックを入れる。
なお、ドライバーを更新しないと設定できない(設定項目がない!)。
電源オプション
(1) スタートを右クリックして「電源オプション」を開く。
(2) 「電源の追加設定」を開く
(3) 「電源ボタンの動作を選択する」を開く
(4) 「現在利用可能ではない設定を変更します」をクリックして「高速スタートアップを有効にする」のチェックを外す。
設定変更した分は保存して、ウィンドウを閉じること。
WoL 側(起動させる端末)
PC の電源を切っておいて、マジックパケットを投げる端末を用意する。
コマンドをインストールしておく
起動用に、Raspberry pi を用意しているのでこちらにアクセスする。
事前に Wake On LAN 用のコマンドをインストールしておく。
いくつかあるけど、今回は wakeonlan コマンドをインストール。
$ sudo apt update $ sudo apt install wakeonlan
これで SSH を利用してログインした Raspberry pi からリモート起動ができるようになる。
Raspbian で RDP
RasPi 4 メモリ 4GB を購入して、せっかくなので専用の 7 inch ディスプレイまで購入。
デスクトップ端末として遊んでいるところで、この端末を RDP 中継用のサーバとして利用できないかなと思って少し調べてみた。
Linux から Windows への RDP 接続
今回試したのが、次の二つ。
- remmina
- rdesktop
remmina
Raspbian での remmina インストール方法
インストールは、いつもの通り。
$ sudo apt update $ sudo apt install remmina
rdesktop
Raspbian での rdesktop インストール方法
インストールは、こちらもいつもの通り。
$ sudo apt update $ sudo apt install rdesktop
うん。
update は remmin のときにやっているから、やらなくてもよかったんだけどね。
自分が使うなら
すぐに対象 Windows へログインできたという意味で、個人的に使いやすかったのが rdesktop だった。
コマンドライン的に、対象を指定する方法が好き。
本当に、単純な好みの問題。
remmina は、目的の動作を実現するアプリではなかったので、ちょっと残念。
でも、文中にも書いたけど、使い方が合っていればすごく優秀と思えた。
実際、思いついて Windows で Xming を起動して Tera Term と連携して remmina を起動したら、使い勝手の良さに驚いた。
……使い分けかなぁ。
Windows から Linux への RDP 接続
いくつかあるようだけれど、最初に試して都合がよかったので使い続けているのが次のアプリ。
- xrdp
Raspbian でのインストール方法
$ sudo apt update $ sudo apt install xrdp
【余談】Windows から Linux への RDP 接続
いくつかあるようだけれど、最初に試して都合がよかったので使い続けているのが次のアプリ。
xrdp
Raspbian でのインストール方法
$ sudo apt install xrdp
Windows のリモートデスクトップ (mstsc.exe) で Linux にアクセス出来るって言うのが、ことのほか楽しい。
Excel VBA で Tera Term Macro を実行
Tera Term マクロを Tera Term に読み込ませるのはコマンドラインで実行すればいいので、シェルから実行させる。
現状、参考程度に。
変更点としては
・マクロを実行するプログラムを呼び出す機能を追加
・マクロファイルの保存先をデスクトップに変更
ttpmacro.exe ってば、ttl ファイルの指定がフルパスでない場合に、自分と同じ場所にないと読み込まないという制限がある。
そして、ttpmacro.exe をデフォルトインストールすると、後から追記しようとするファイルがユーザアカウント制御 (UAC) により別管理されることがあり、うまく動いてくれない可能性があるという……
ということで、とりあえずデスクトップに置く仕様にしている。
WSH.SpecialFolders に指定した場所を変えれば、いろいろ対応できそう。
あと、以前実装した ping 機能は、今回は割愛。
応用としては、ttpmacro.exe ではなく ttermpro.exe に、シェル(コマンドライン)からオプション指定してもいい……というか、シンプルな内容ならそちらの方がよさそう。
ソース
以下、出来上がったソースを。
まず Excel の ThisWorkbook に貼り付けて xlsm 形式で保存する。
A2 以下 A 列にアクセス先サーバ名もしくは IP アドレスを。
B2 以下 B 列に使用するユーザID を。
保存したら、A列に入力したアクセス先をダブルクリックすると、Tera Term が起動してくれる。
なお Tera Term は C ドライブにインストールしている前提。
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean) ' Excel VBA マクロによる TeraTerm マクロ生成するサンプルソース(暫定版) ' Modify : 黒猫666 - 2013/1/1 ' Update : 黒猫666 - 2020/3/20 ' Site : http://d.hatena.ne.jp/KuroNeko666 ''' 変数の宣言 '''''''''''''''''''''''''''''''''''''''''''' ' Object 設定 Dim FSO As Object Dim TXT As Object Dim WSH As Object ' 変数設定 Dim pFILEDIR As String ' 格納先ディレクトリ Dim pFILE As String ' TeraTerm マクロ用ファイル名 Dim pFILEPATH As String Dim pHOST As String ' アクセスするサーバ用変数 Dim pUSER As String ' アクセスユーザ用変数 Dim pPID As Double ' 列数設定 Dim nHOST As Integer ' アクセス先 Dim nUSER As Integer ' ユーザID ' Tera Term 実行ファイル Dim pTTERMDIR As String ' インストールフォルダ Dim pTTMEXE As String ' Tera Term マクロ実行 Dim pTTMACROPATH As String ' インストールパス ' マクロファイル格納先 ''' 変数の定義 '''''''''''''''''''''''''''''''''''''''''''' ' デフォルト定義 Set WSH = CreateObject("WScript.Shell") pFILEDIR = WSH.SpecialFolders("Desktop") pFILE = "teratermmacro.ttl" pHOST = "localhost" ' アクセス先(定義だけ) pUSER = "default" ' ユーザID pFILEPATH = pFILEDIR & "\" & pFILE ' 列の数値定義 nHOST = 1 ' アクセス先 nUSER = 2 ' ユーザID pTTERMDIR = "c:\Program Files (x86)\teraterm" pTTMEXE = "ttpmacro.exe" pTTMACROPATH = pTTERMDIR & "\" & pTTMEXE ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' 強制初期化… Cells(1, 1) = "アクセス先サーバ" Cells(1, 2) = "ユーザID" ' ダブルクリックしたセルが A 列じゃなかったり、さらに 1 行目だったりしたら、強制終了。 If Intersect(Target, Range("A:A")) Is Nothing Or Target.Row = 1 Then Exit Sub Cancel = True ' セルの色彩情報で、処理を変更 If Target.Interior.ColorIndex = xlNone Then ' もしアクセス先の記載がなかったら終了。 If Target.Value = "" Then Exit Sub Else ' あったら、とりあえず信じ込む。 pHOST = Target.Value End If Target.Interior.ColorIndex = 6 ' 併せて 2 列目に入力があれば、ユーザIDだと信じ込む。 If Cells(Target.Row, nUSER) <> "" Then pUSER = Cells(Target.Row, nUSER) End If Else Target.Interior.ColorIndex = xlNone Exit Sub End If Cancel = True Set FSO = CreateObject("Scripting.FileSystemObject") ' 上書き : する = true, しない = false (存在したらエラー) ' 文字コード : Unicode(UTF) = true, ASCII = false Set TXT = FSO.CreateTextFile(pFILEPATH, True, False) TXT.WriteLine ("; Generate by Excel VBA (KuroNeko666)") TXT.WriteLine ("; Original ttl by TeraTerm sample") TXT.WriteLine ("; Creation http://d.hatena.ne.jp/KuroNeko666/20130101") TXT.WriteLine ("") TXT.WriteLine ("username = '" & pUSER & "'") TXT.WriteLine ("hostname = '" & pHOST & "'") TXT.WriteLine ("") TXT.WriteLine (";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;") TXT.WriteLine ("") TXT.WriteLine ("msg = 'Enter password for user '") TXT.WriteLine ("strconcat msg username") TXT.WriteLine ("passwordbox msg 'Get password'") TXT.WriteLine ("") TXT.WriteLine ("msg = hostname") TXT.WriteLine ("strconcat msg ':22 /ssh /auth=password /user='") TXT.WriteLine ("strconcat msg username") TXT.WriteLine ("strconcat msg ' /passwd='") TXT.WriteLine ("strconcat msg inputstr") TXT.WriteLine ("") TXT.WriteLine ("connect msg") TXT.Close Set TXT = Nothing ' 作成したマクロを利用して、対象ホストにアクセス pPID = Shell(pTTMACROPATH & " " & pFILEPATH) Set FSO = Nothing End Sub
Excel VBA で祝日一覧を出力
まだちょっと不便なところがある……というか、貼り付けてそのまま関数書けば実行できるということろまではいけなかったんだけども。
一応、ActiveX のボタン(フォームコントロールのボタンでは呼び出せなかった)もしくは、メニューに項目を追加して、そこで関数名で呼び出せばなんとかリスト出力まではできるようになったので、残しておく。
2019年、2020年の、なんとイレギュラーなことか。
いちおう、2030年までは、他のサイトの情報と照らし合わせて正確に出力していることを確認済み。
この1~2年のようなイレギュラーがなければ、問題なく動いてくれるだろう。
これで、この関数は
・休日・祝日判定
・第x週目の月曜日を出力
・祝日リスト出力
という、なんとも気の抜けそうな機能を充実させることに成功した!
Option Explicit ' セル位置関係 Dim aRow As Long Dim aCol As Long Dim wi As Long Function getHolidayList() ' ######################################################################### ' # 西暦を入れるとアクティブセルから下に祝日一覧を入れるマクロ ' # セルに関数名を入れた使い方はできないので、改造中。 ' # ActiveX コントロールのボタン、もしくはメニューバーから呼び出すこと。 ' ######################################################################### Dim msgInputYear As String Dim msgOverRideChk As String Dim pInputYear As Variant Dim chk As Variant Dim tmp As Variant msgInputYear = "出力したい西暦を入力してください。" msgOverRideChk = "現在のアクティブセルから下に2列、リストを出力します。" & vbCrLf & "(既存の情報は上書き)" wi = 1 pInputYear = InputBox(msgInputYear, "西暦", Year(Now)) Select Case VarType(pInputYear) ' Empty値 (0) Case vbEmpty Exit Function ' 文字列型 (8) Case vbString pInputYear = StrConv(pInputYear, vbNarrow) Case Else MsgBox "Error" End Select If IsNumeric(pInputYear) = False Then 'MsgBox "数字を入力してください", vbOKOnly, "Error" Exit Function End If If MsgBox(msgOverRideChk, vbYesNo) Then ' アクティブセルの位置を取得 aRow = ActiveCell.Row aCol = ActiveCell.Column Cells(aRow, aCol) = pInputYear & "年" Cells(aRow, aCol + 1) = "祝日" '元日 1月1日 tmp = DateValue(pInputYear & "/1/1") chk = wDD(tmp, "元日") If Weekday(tmp + 1) = vbMonday Then chk = wDD(tmp + 1, "振替休日") '成人の日 1月の第2月曜日 chk = wDD(NumWeek(pInputYear, 1, 2), "成人の日") '建国記念の日 政令で定める日(2/11) tmp = DateValue(pInputYear & "/2/11") chk = wDD(tmp, "建国記念の日") If Weekday(tmp + 1) = vbMonday Then chk = wDD(tmp + 1, "振替休日") '天皇誕生日 12月23日 → 2月23日(2019年 天皇の即位に伴う変更) If 2019 < pInputYear Then chk = wDD(DateValue(pInputYear & "/2/23"), "天皇誕生日") If Weekday(DateValue(pInputYear & "/2/24")) = vbMonday Then chk = wDD(DateValue(pInputYear & "/2/24"), "振替休日") End If '春分の日 tmp = DateValue(pInputYear & "/3/" & Int(20.8431 + 0.242194 * (pInputYear - 1980) - Int((pInputYear - 1980) / 4))) chk = wDD(tmp, "春分の日") If Weekday(tmp + 1) = vbMonday Then chk = wDD(tmp + 1, "振替休日") '昭和の日 4月29日 tmp = DateValue(pInputYear & "/4/29") chk = wDD(tmp, "昭和の日") If Weekday(tmp + 1) = vbMonday Then chk = wDD(tmp + 1, "振替休日") '天皇の即位の日 2019年5月1日 If pInputYear = 2019 Then chk = wDD(DateValue("2019/4/30"), "国民の休日") chk = wDD(DateValue("2019/5/1"), "天皇の即位の日") chk = wDD(DateValue("2019/5/2"), "国民の休日") End If '憲法記念日 5月3日 chk = wDD(DateValue(pInputYear & "/5/3"), "憲法記念日") 'みどりの日 5月4日 chk = wDD(DateValue(pInputYear & "/5/4"), "みどりの日") 'こどもの日 5月5日 tmp = DateValue(pInputYear & "/5/5") chk = wDD(tmp, "こどもの日") ' 5月5日が日曜~火曜日だったら、振替休日確定 If vbSunday <= Weekday(tmp) And Weekday(tmp) <= vbTuesday Then chk = wDD(tmp + 1, "振替休日") End If '海の日 7月の第3月曜日 If pInputYear = 2020 Then chk = wDD(DateValue("2020/7/23"), "海の日") chk = wDD(DateValue("2020/7/24"), "スポーツの日") Else tmp = NumWeek(pInputYear, 7, 3) chk = wDD(tmp, "海の日") If Weekday(tmp + 1) = vbMonday Then chk = wDD(tmp + 1, "振替休日") End If '山の日 8月11日 If pInputYear = 2020 Then chk = wDD(DateValue("2020/8/10"), "山の日") Else tmp = DateValue(pInputYear & "/8/11") chk = wDD(tmp, "山の日") If Weekday(tmp + 1) = vbMonday Then chk = wDD(tmp + 1, "振替休日") End If '敬老の日 9月の第3月曜日 chk = wDD(NumWeek(pInputYear, 9, 3), "敬老の日") '国民の休日 祝日に挟まれた平日 tmp = DateValue(pInputYear & "/9/" & Int(23.2488 + 0.242194 * (pInputYear - 1980) - Int((pInputYear - 1980) / 4))) 'If Weekday(tmp) = vbWednesday Then chk = wDD(tmp - 1, "国民の休日") If tmp - 2 = NumWeek(pInputYear, 9, 3) Then chk = wDD(tmp - 1, "国民の休日") '秋分の日 'tmp = DateValue(pInputYear & "/9/" & Int(23.2488 + 0.242194 * (pInputYear - 1980) - Int((pInputYear - 1980) / 4))) chk = wDD(DateValue(tmp), "秋分の日") If Weekday(tmp + 1) = vbMonday Then chk = wDD(tmp + 1, "振替休日") '体育の日 10月の第2月曜日 (2020年からスポーツの日に名称変更) If pInputYear < 2020 Then chk = wDD(NumWeek(pInputYear, 10, 2), "体育の日") Else If pInputYear <> 2020 Then chk = wDD(NumWeek(pInputYear, 10, 2), "スポーツの日") End If '即位礼正殿の儀の行われる日 2019年10月22日 If pInputYear = 2019 Then chk = wDD(DateValue("2019/10/22"), "即位礼正殿の儀の行われる日") '文化の日 11月3日 tmp = DateValue(pInputYear & "/11/3") chk = wDD(tmp, "文化の日") If Weekday(tmp + 1) = vbMonday Then chk = wDD(tmp + 1, "振替休日") '勤労感謝の日 11月23日 tmp = DateValue(pInputYear & "/11/23") chk = wDD(tmp, "勤労感謝の日") If Weekday(tmp + 1) = vbMonday Then chk = wDD(tmp + 1, "振替休日") '天皇誕生日 12月23日 → 2月23日(2019年 天皇の即位に伴う変更) If pInputYear < 2019 Then tmp = DateValue(pInputYear & "/12/23") chk = wDD(tmp, "天皇誕生日") If Weekday(tmp + 1) = vbMonday Then chk = wDD(tmp + 1, "振替休日") End If End If End Function Public Function wDD(Serial, HolidayName) ' Write Date Data Cells(aRow + wi, aCol) = Serial Cells(aRow + wi, aCol + 1) = HolidayName wi = wi + 1 End Function Public Function chkWorkDay(Optional Serial As Date) ' ######################################################################### ' # 呼び出されると、翌営業日を返すマクロ ' # 2020/3/11 初版作成 ' ######################################################################### ' ### 変数 ################################################################ Dim chkDate As Date Dim fDate As Integer If Serial > 0 Then chkDate = Serial Else chkDate = Date End If fDate = 1 ' ### メイン ############################################################## Do While fDate > 0 chkDate = chkDate + 1 fDate = chkHoliday(chkDate) Loop ' ### 終了処理 ############################################################ chkWorkDay = chkDate End Function Public Function chkHoliday(Serial, Optional RVFlag As Byte = 0) ' ######################################################################### ' # 呼び出されると、引数のSerialから休日/祝日判定フラグを返すマクロ ' # 更新履歴 ' # 2019/12/5 2020年の特殊な祝日情報に対応した。 ' # 2020/3/11 土日を休日と返すようにした。 ' ######################################################################### ' 戻り値の定義 ' 0 = 平日 ' 1 = 日曜日(vbSunday) ' 7 = 土曜日(vbSaturday) ' 8 = 祝日 ' 変数の宣言 Dim RV As Byte Dim DayName As String Dim YYYY As Integer Dim fSubstitute As Boolean ' 振替休日フラグ ' ### メイン ############################################################## DayName = "平日" YYYY = Year(Serial) ' ## 祝日判定 ##### '元日 1月1日 '成人の日 1月の第2月曜日 '建国記念の日 政令で定める日(2/11) '春分の日 春分の日 '昭和の日 4月29日 '憲法記念日 5月3日 'みどりの日 5月4日 'こどもの日 5月5日 '海の日 7月の第3月曜日 '山の日 8月11日 '敬老の日 9月の第3月曜日 '秋分の日 秋分の日 '体育の日 10月の第2月曜日 (2020年からスポーツの日に名称変更) '文化の日 11月3日 '勤労感謝の日 11月23日 '天皇誕生日 12月23日 → 2月23日(2019年 天皇の即位に伴う変更) '国民の休日 祝日に挟まれた平日 '天皇の即位の日及び即位礼正殿の儀の行われる日を休日とする法律 2019年5月1日と2019年10月22日 ' 規定の日付 Select Case Serial Case DateValue(YYYY & "/1/1") DayName = "元旦" Case DateValue(YYYY & "/1/2") DayName = "年始" Case DateValue(YYYY & "/1/3") DayName = "年始" Case NumWeek(YYYY, 1, 2) DayName = "成人の日" Case DateValue(YYYY & "/2/11") DayName = "建国記念の日" Case DateValue(YYYY & "/2/23") If 2019 < YYYY Then DayName = "天皇誕生日" End If Case DateValue(YYYY & "/3/" & Int(20.8431 + 0.242194 * (YYYY - 1980) - Int((YYYY - 1980) / 4))) ' 参考URL http://www.wanichan.com/pc/excel/2010/5/page07.html DayName = "春分の日" Case DateValue(YYYY & "/4/29") DayName = "昭和の日" Case DateValue("2019/4/30") DayName = "国民の休日" Case DateValue("2019/5/1") DayName = "天皇の即位の日" Case DateValue("2019/5/2") DayName = "国民の休日" Case DateValue(YYYY & "/5/3") DayName = "憲法記念日" Case DateValue(YYYY & "/5/4") DayName = "みどりの日" Case DateValue(YYYY & "/5/5") DayName = "こどもの日" Case NumWeek(YYYY, 7, 3) DayName = "海の日" Case DateValue(YYYY & "/8/11") DayName = "山の日" Case NumWeek(YYYY, 9, 3) DayName = "敬老の日" Case NumWeek(YYYY, 9, 3) + 1 If DateValue(YYYY & "/9/" & Int(23.2488 + 0.242194 * (YYYY - 1980) - Int((YYYY - 1980) / 4))) = NumWeek(YYYY, 9, 3) + 2 Then DayName = "国民の休日" End If Case DateValue(YYYY & "/9/" & Int(23.2488 + 0.242194 * (YYYY - 1980) - Int((YYYY - 1980) / 4))) ' 参考URL http://www.wanichan.com/pc/excel/2010/5/page07.html DayName = "秋分の日" Case NumWeek(YYYY, 10, 2) If YYYY <= 2019 Then DayName = "体育の日" Else DayName = "スポーツの日" End If Case DateValue("2019/10/22") DayName = "即位礼正殿の儀の行われる日" Case DateValue(YYYY & "/11/3") DayName = "文化の日" Case DateValue(YYYY & "/11/23") DayName = "勤労感謝の日" Case DateValue(YYYY & "/12/23") If YYYY < 2019 Then DayName = "天皇誕生日" End If Case DateValue(YYYY & "/12/31") DayName = "年末" End Select ' 振替休日 ' 「国民の祝日」が日曜日に当たるときは、その日後においてその日に最も近い「国民の祝日」でない日を休日とする ' なので「国民の祝日」の翌日が月曜日だったときも、振替休日となる Select Case Serial Case DateValue(YYYY & "/1/1") + 1 If Weekday(Serial) = vbMonday Then fSubstitute = True Case DateValue(YYYY & "/2/11") + 1 If Weekday(Serial) = vbMonday Then fSubstitute = True Case DateValue(YYYY & "/2/23") + 1 If YYYY > 2019 And Weekday(Serial) = vbMonday Then fSubstitute = True Case DateValue(YYYY & "/3/" & Int(20.8431 + 0.242194 * (YYYY - 1980) - Int((YYYY - 1980) / 4))) + 1 If Weekday(Serial) = vbMonday Then fSubstitute = True Case DateValue(YYYY & "/4/29") + 1 If Weekday(Serial) = vbMonday Then fSubstitute = True Case DateValue(YYYY & "/5/5") + 1 ' 5月5日が日曜~火曜日だったら、振替休日確定 If vbSunday <= Weekday(DateValue(YYYY & "/5/5")) And Weekday(DateValue(YYYY & "/5/5")) <= vbTuesday Then fSubstitute = True Case DateValue(YYYY & "/9/" & Int(23.2488 + 0.242194 * (YYYY - 1980) - Int((YYYY - 1980) / 4))) + 1 If Weekday(Serial) = vbMonday Then fSubstitute = True Case DateValue(YYYY & "/11/3") + 1 If Weekday(Serial) = vbMonday Then fSubstitute = True Case DateValue(YYYY & "/11/23") + 1 If Weekday(Serial) = vbMonday Then fSubstitute = True Case DateValue(YYYY & "/12/23") + 1 If YYYY < 2019 And Weekday(Serial) = vbMonday Then fSubstitute = True End Select If fSubstitute = True Then DayName = "振替休日" End If ' 2020年特殊対応 Select Case Serial Case DateValue("2020/7/20") DayName = "平日" Case NumWeek(2020, 10, 2) DayName = "平日" Case DateValue("2020/8/11") DayName = "平日" Case DateValue("2020/7/23") DayName = "海の日" Case DateValue("2020/7/24") DayName = "スポーツの日" Case DateValue("2020/8/10") DayName = "山の日" Case DateValue("2020/9/22") DayName = "秋分の日" End Select ' 祝日値判定 If DayName = "平日" Then ' ## 曜日選択 ##### If IsDate(Serial) Then Select Case Weekday(Serial) Case vbSunday RV = vbSunday DayName = "休日" 'Case vbMonday ' RV = vbMonday 'Case vbTuesday ' RV = vbTuesday 'Case vbWednesday ' RV = vbWednesday 'Case vbThursday ' RV = vbThursday 'Case vbFriday ' RV = vbFriday Case vbSaturday RV = vbSaturday DayName = "休日" End Select 'RV = Weekday(Serial) Else Exit Function End If Else RV = 8 End If ' ### 終了処理 ############################################################ Select Case RVFlag Case 0 chkHoliday = RV Case 1 chkHoliday = DayName End Select End Function Public Function NumWeek(Year, Month, Weeks) ' 参考資料 ' http://www.relief.jp/itnote/archives/003241.php Dim MonNum As Byte Dim FirstMonDay As Date ' 第1週目の月曜日を求める Select Case Weekday(DateValue(Year & "/" & Month & "/1")) Case vbSunday ' 1 MonNum = 1 Case vbMonday ' 2 MonNum = 0 Case vbTuesday ' 3 MonNum = 6 Case vbWednesday ' 4 MonNum = 5 Case vbThursday ' 5 MonNum = 4 Case vbFriday ' 6 MonNum = 3 Case vbSaturday ' 7 MonNum = 2 End Select FirstMonDay = DateValue(Year & "/" & Month & "/" & 1 + MonNum) ' 第1週目月曜日から何週間後なのか、シリアル値を出力 NumWeek = DateValue(Year & "/" & Month & "/" & 1 + MonNum) + 7 * (Weeks - 1) End Function
Excel VBA で翌営業日判定
過去作成した、休日/祝日判定を応用して、翌営業日を返すマクロを書いてみました。
Excel VBA で休日祝日判定(再掲) - KuroNeko666’s blog
Excel で休日祝日判定 - KuroNeko666’s blog
もちろん Excel ですから workday 関数を使っても良いのですが、休日や祝日を自分で判定する関数をつくっているのですから簡単だと思ったのですよね。
体裁にこだわらないなら、10行も必要ないプログラムになりました。
まるっと貼り付けておきます。
Option Explicit Public Function chkWorkDay(Optional Serial As Date) ' ######################################################################### ' # 呼び出されると、翌営業日を返すマクロ ' # 2020/3/11 初版作成 ' ######################################################################### ' ### 変数 ################################################################ Dim chkDate As Date Dim fDate As Integer If Serial > 0 Then chkDate = Serial Else chkDate = Date End If fDate = 1 ' ### メイン ############################################################## Do While fDate > 0 chkDate = chkDate + 1 fDate = chkHoliday(chkDate) Loop ' ### 終了処理 ############################################################ chkWorkDay = chkDate End Function Public Function chkHoliday(Serial, Optional RVFlag As Byte = 0) ' ######################################################################### ' # 呼び出されると、引数のSerialから休日/祝日判定フラグを返すマクロ ' # 更新履歴 ' # 2019/12/5 2020年の特殊な祝日情報に対応した。 ' # 2020/3/11 土日を休日と返すようにした。 ' ######################################################################### ' 戻り値の定義 ' 0 = 平日 ' 1 = 日曜日(vbSunday) ' 7 = 土曜日(vbSaturday) ' 8 = 祝日 ' 変数の宣言 Dim RV As Byte Dim DayName As String Dim YYYY As Integer Dim fSubstitute As Boolean ' 振替休日フラグ ' ### メイン ############################################################## DayName = "平日" YYYY = Year(Serial) ' ## 祝日判定 ##### '元日 1月1日 '成人の日 1月の第2月曜日 '建国記念の日 政令で定める日(2/11) '春分の日 春分の日 '昭和の日 4月29日 '憲法記念日 5月3日 'みどりの日 5月4日 'こどもの日 5月5日 '海の日 7月の第3月曜日 '山の日 8月11日 '敬老の日 9月の第3月曜日 '秋分の日 秋分の日 '体育の日 10月の第2月曜日 (2020年からスポーツの日に名称変更) '文化の日 11月3日 '勤労感謝の日 11月23日 '天皇誕生日 12月23日 → 2月23日(2019年 天皇の即位に伴う変更) '国民の休日 祝日に挟まれた平日 '天皇の即位の日及び即位礼正殿の儀の行われる日を休日とする法律 2019年5月1日と2019年10月22日 ' 規定の日付 Select Case Serial Case DateValue(YYYY & "/1/1") DayName = "元旦" Case DateValue(YYYY & "/1/2") DayName = "年始" Case DateValue(YYYY & "/1/3") DayName = "年始" Case NumWeek(YYYY, 1, 2) DayName = "成人の日" Case DateValue(YYYY & "/2/11") DayName = "建国記念の日" Case DateValue(YYYY & "/2/23") If 2019 < YYYY Then DayName = "天皇誕生日" End If Case DateValue(YYYY & "/3/" & Int(20.8431 + 0.242194 * (YYYY - 1980) - Int((YYYY - 1980) / 4))) ' 参考URL http://www.wanichan.com/pc/excel/2010/5/page07.html DayName = "春分の日" Case DateValue(YYYY & "/4/29") DayName = "昭和の日" Case DateValue("2019/4/30") DayName = "国民の休日" Case DateValue("2019/5/1") DayName = "天皇の即位の日" Case DateValue("2019/5/2") DayName = "国民の休日" Case DateValue(YYYY & "/5/3") DayName = "憲法記念日" Case DateValue(YYYY & "/5/4") DayName = "みどりの日" Case DateValue(YYYY & "/5/5") DayName = "こどもの日" Case NumWeek(YYYY, 7, 3) DayName = "海の日" Case DateValue(YYYY & "/8/11") DayName = "山の日" Case NumWeek(YYYY, 9, 3) DayName = "敬老の日" Case NumWeek(YYYY, 9, 3) + 1 If DateValue(YYYY & "/9/" & Int(23.2488 + 0.242194 * (YYYY - 1980) - Int((YYYY - 1980) / 4))) = NumWeek(YYYY, 9, 3) + 2 Then DayName = "国民の休日" End If Case DateValue(YYYY & "/9/" & Int(23.2488 + 0.242194 * (YYYY - 1980) - Int((YYYY - 1980) / 4))) ' 参考URL http://www.wanichan.com/pc/excel/2010/5/page07.html DayName = "秋分の日" Case NumWeek(YYYY, 10, 2) If YYYY <= 2019 Then DayName = "体育の日" Else DayName = "スポーツの日" End If Case DateValue("2019/10/22") DayName = "即位礼正殿の儀の行われる日" Case DateValue(YYYY & "/11/3") DayName = "文化の日" Case DateValue(YYYY & "/11/23") DayName = "勤労感謝の日" Case DateValue(YYYY & "/12/23") If YYYY < 2019 Then DayName = "天皇誕生日" End If Case DateValue(YYYY & "/12/31") DayName = "年末" End Select ' 振替休日 ' 「国民の祝日」が日曜日に当たるときは、その日後においてその日に最も近い「国民の祝日」でない日を休日とする ' なので「国民の祝日」の翌日が月曜日だったときも、振替休日となる Select Case Serial Case DateValue(YYYY & "/1/1") + 1 If Weekday(Serial) = vbMonday Then fSubstitute = True Case DateValue(YYYY & "/2/11") + 1 If Weekday(Serial) = vbMonday Then fSubstitute = True Case DateValue(YYYY & "/2/23") + 1 If YYYY > 2019 And Weekday(Serial) = vbMonday Then fSubstitute = True Case DateValue(YYYY & "/3/" & Int(20.8431 + 0.242194 * (YYYY - 1980) - Int((YYYY - 1980) / 4))) + 1 If Weekday(Serial) = vbMonday Then fSubstitute = True Case DateValue(YYYY & "/4/29") + 1 If Weekday(Serial) = vbMonday Then fSubstitute = True Case DateValue(YYYY & "/5/5") + 1 ' 5月5日が日曜~火曜日だったら、振替休日確定 If vbSunday <= Weekday(DateValue(YYYY & "/5/5")) And Weekday(DateValue(YYYY & "/5/5")) <= vbTuesday Then fSubstitute = True Case DateValue(YYYY & "/9/" & Int(23.2488 + 0.242194 * (YYYY - 1980) - Int((YYYY - 1980) / 4))) + 1 If Weekday(Serial) = vbMonday Then fSubstitute = True Case DateValue(YYYY & "/11/3") + 1 If Weekday(Serial) = vbMonday Then fSubstitute = True Case DateValue(YYYY & "/11/23") + 1 If Weekday(Serial) = vbMonday Then fSubstitute = True Case DateValue(YYYY & "/12/23") + 1 If YYYY < 2019 And Weekday(Serial) = vbMonday Then fSubstitute = True End Select If fSubstitute = True Then DayName = "振替休日" End If ' 2020年特殊対応 Select Case Serial Case DateValue("2020/7/20") DayName = "平日" Case NumWeek(2020, 10, 2) DayName = "平日" Case DateValue("2020/8/11") DayName = "平日" Case DateValue("2020/7/23") DayName = "海の日" Case DateValue("2020/7/24") DayName = "スポーツの日" Case DateValue("2020/8/10") DayName = "山の日" Case DateValue("2020/9/22") DayName = "秋分の日" End Select ' 祝日値判定 If DayName = "平日" Then ' ## 曜日選択 ##### If IsDate(Serial) Then Select Case Weekday(Serial) Case vbSunday RV = vbSunday DayName = "休日" 'Case vbMonday ' RV = vbMonday 'Case vbTuesday ' RV = vbTuesday 'Case vbWednesday ' RV = vbWednesday 'Case vbThursday ' RV = vbThursday 'Case vbFriday ' RV = vbFriday Case vbSaturday RV = vbSaturday DayName = "休日" End Select 'RV = Weekday(Serial) Else Exit Function End If Else RV = 8 End If ' ### 終了処理 ############################################################ Select Case RVFlag Case 0 chkHoliday = RV Case 1 chkHoliday = DayName End Select End Function Public Function NumWeek(Year, Month, Weeks) ' 参考資料 ' http://www.relief.jp/itnote/archives/003241.php Dim MonNum As Byte Dim FirstMonDay As Date ' 第1週目の月曜日を求める Select Case Weekday(DateValue(Year & "/" & Month & "/1")) Case vbSunday ' 1 MonNum = 1 Case vbMonday ' 2 MonNum = 0 Case vbTuesday ' 3 MonNum = 6 Case vbWednesday ' 4 MonNum = 5 Case vbThursday ' 5 MonNum = 4 Case vbFriday ' 6 MonNum = 3 Case vbSaturday ' 7 MonNum = 2 End Select FirstMonDay = DateValue(Year & "/" & Month & "/" & 1 + MonNum) ' 第1週目月曜日から何週間後なのか、シリアル値を出力 NumWeek = DateValue(Year & "/" & Month & "/" & 1 + MonNum) + 7 * (Weeks - 1) End Function