アウトドアブランド

アウトドアブランド

Twinings Darjeeling Tea

最近はコーヒーをメインで飲むようになっているけど、以前は紅茶がメインだった。
その名残で、今も定期的に購入しているのが Twinings のダージリン

f:id:KuroNeko666:20200830063211j:plain
普段は袋で買っていたのだけれど、気まぐれを起こして缶で買ってみた。
このダージリンは、袋と缶とで茶葉のグレードが違う?
ブランドとしてのグレードが違う?


左側のように、ペコー的なものを想像してたんだけど、缶の中身はファニングスかダストに見える。
ペコーとかファニングス、ダストについては、こちらを参照してほしい。
www.rakuten.ne.jp


グレードと書いてあるけど、それぞれ向く抽出方法が違う。なので、品質というよりは好みの使い方をすればよいかと。


f:id:KuroNeko666:20200830063228j:plain
いつも購入しているタイプの袋は Darjeeling Extra と書いてあるけど、缶の方は無いんだよね。
1杯分 3g に、熱湯 140ml を入れて4分の蒸し時間。

まぁ、渋みがきつく感じるので、大体 2 分くらいで蒸し時間を終わらせているけど。
この辺は個人の好みの範疇。

f:id:KuroNeko666:20200830063237j:plain
缶のほうは、完全に細切れ。
1杯分 3g に、熱湯 140ml を入れて4分の蒸し時間。


茶葉のサイズが違うのに抽出時間が同じとか、おかしくない!?

f:id:KuroNeko666:20200830063345j:plain
1mm あるかどうか……という感じなので、本来ならティーバッグに使うようなグレードのもののように見えるんだけど。

f:id:KuroNeko666:20200830063436j:plain
いつも飲んでる方を、実際に抽出してみたところ。

f:id:KuroNeko666:20200830063722j:plain
葉っぱは、キレイに開いてくれている。
トワイニング といったら、これだよね。


次に、缶のほうを。
f:id:KuroNeko666:20200830072311j:plain
缶のほうを抽出してみたところ。
量(軽量スプーン1.5)や抽出時間(2分)は同じだけど、やっぱり渋い。


失敗した。

説明書の読み比べを。
f:id:KuroNeko666:20200830063814j:plain
f:id:KuroNeko666:20200830063829j:plain

うん、書いてある淹れ方は同じ。


ちなみの、片岡物産はインドからトワイニングブランドを輸入している会社で、トワイニング・ジャパンはトワイニング片岡物産合弁会社のこと。
モノとしては、中身は同じはずだったんだけどな。

Wake On LAN 起動設定

購入した PC の Wake On LAN 設定方法

購入した PC は、適当に Amazon で選んだ次の PC
UフォレストPC 第9世代 Core i7搭載ゲーミングデスクトップパソコン

(2019秋モデルver2.10【ブラック Windows10単品】)

こちらを Wake On LAN で遠隔起動するための設定。

Wake On LAN とは?

事前に設定されたパソコンは、ネットワークアダプターに特殊なコマンドを受信すると OS を起動する。


今回は、常時起動している Raspberry pi からリモートで起動させる設定を行う。
(自宅ルータでブロードキャストアドレスに変換させる方法等もあるけど、すでに用意している環境を利用)
f:id:KuroNeko666:20200728055908p:plain


メリットとしては、消費電力の高い 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

ネットワークアダプタ

「スタート」を右クリックして、デバイスマネージャーを起動する。
ネットワークアダプターから対象アダプターのドライバーを更新しておく
これは「ドライバーソフトウェアの最新版を自動検索」でインストールして良い。

f:id:KuroNeko666:20200727230019p:plain


次に、プロパティを開く。
「詳細設定」タブを選んで、「省電力イーサネット」があればオフにする。
同じく「詳細設定」タブで「ウェイク・オン・マジックパケット」「ウェイク・オン・パターン・マッチ」等を「有効」にする。
この辺の設定はドライバーのバージョンで変わるので、その都度判断するしかない。


次に「電源の管理」タブを選んで、「Magic Packet でのみ、コンピューターのスタンバイ状態を解除できるようにする」にチェックを入れる。
f:id:KuroNeko666:20200727230048p:plain

なお、ドライバーを更新しないと設定できない(設定項目がない!)。

電源オプション

(1) スタートを右クリックして「電源オプション」を開く。
(2) 「電源の追加設定」を開く
(3) 「電源ボタンの動作を選択する」を開く
(4) 「現在利用可能ではない設定を変更します」をクリックして「高速スタートアップを有効にする」のチェックを外す。

f:id:KuroNeko666:20200727225923p:plain

設定変更した分は保存して、ウィンドウを閉じること。

MAC アドレス

リモート起動用のマジックパケットを投げつけるネットワークアダプターの MAC アドレスを調べておく。

例えばコマンドプロンプトで表示させる方法。

>arp -a

WoL 側(起動させる端末)

PC の電源を切っておいて、マジックパケットを投げる端末を用意する。

コマンドをインストールしておく

起動用に、Raspberry pi を用意しているのでこちらにアクセスする。
事前に Wake On LAN 用のコマンドをインストールしておく。


いくつかあるけど、今回は wakeonlan コマンドをインストール。

$ sudo apt update
$ sudo apt install wakeonlan

これで SSH を利用してログインした Raspberry pi からリモート起動ができるようになる。

スマホから ssh 接続するのに ConnectBot というアプリを愛用中。

リモート起動を試してみる

事前に調べておいた MAC アドレスに、リモート起動用のマジックパケットを投げる。

$ wakeonlan xx:xx:xx:xx:xx:xx

うまくいけば PC が起動する。
リモート起動した PC に RDP するには Windows が起動してから 5 分くらい待つ必要があるみたい。

スマホには、Microsoft 謹製の RDP アプリがあるので、それを利用。

Raspbian で RDP

RasPi 4 メモリ 4GB を購入して、せっかくなので専用の 7 inch ディスプレイまで購入。
デスクトップ端末として遊んでいるところで、この端末を RDP 中継用のサーバとして利用できないかなと思って少し調べてみた。

Linux から Windows への RDP 接続

今回試したのが、次の二つ。

  • remmina
  • rdesktop

remmina

Raspbian での remmina インストール方法

インストールは、いつもの通り。

$ sudo apt update
$ sudo apt install remmina
起動方法(デスクトップ画面)

スタートメニューから「インターネット」→「Remmina」
f:id:KuroNeko666:20200419171308p:plain

すると、どこへ、何を使って、どのユーザでアクセスするのか、を入力する Web GUI が表示される。

f:id:KuroNeko666:20200419173509p:plain

起動方法(コマンドライン

スタートメニューから「Run」の画面を出して、次のコマンドを実行。
f:id:KuroNeko666:20200419172829p:plain

remmina

次のコマンドラインは、GUI とか Xming とかを使っている環境で利用する想定。

$ remmina

WebGUI を介したリモートデスクトップ接続。
一度ブラウザが開くので、そこでアクセス先を入力すると、ウィンドウが開く。
設定ファイルを作ればスキップできそうに思えるが、それでも少し手間と感じる。

ただ、RDP 以外にも VNCSSH 等の選択肢がある。
RDP アプリではなく、ターミナル機能を有したサーバ(Webアプリ)だと思えば、優秀と思える。

rdesktop

Raspbian での rdesktop インストール方法

インストールは、こちらもいつもの通り。

$ sudo apt update
$ sudo apt install rdesktop

うん。
update は remmin のときにやっているから、やらなくてもよかったんだけどね。

起動方法(コマンドライン

スタートメニューから「Run」の画面を出して、次のコマンドを実行。
f:id:KuroNeko666:20200419172829p:plain

rdesktop xx.xx.xx.xx

次のコマンドラインは、GUI とか Xming とかを使っている環境で利用する想定。

$ rdesktop xx.xx.xx.xx

リモートデスクトップで接続した先の画面は、ウィンドウが開く。
オプションでフルスクリーン等を指定する。
CUI に慣れていると、こちらの方が直感的に扱いやすい。

自分が使うなら

すぐに対象 Windows へログインできたという意味で、個人的に使いやすかったのが rdesktop だった。
コマンドライン的に、対象を指定する方法が好き。

本当に、単純な好みの問題。

remmina は、目的の動作を実現するアプリではなかったので、ちょっと残念。
でも、文中にも書いたけど、使い方が合っていればすごく優秀と思えた。
実際、思いついて WindowsXming を起動して Tera Term と連携して remmina を起動したら、使い勝手の良さに驚いた。

www.mikitechnica.com

……使い分けかなぁ。

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