「今さら」なんてない

「自分にもできそう」を伝播させるブログ

開始予定/終了予定/見積時間のうち、どれか2つが埋まったら残りの1つを自動計算する【ExcelVBA】

またもスケジュール管理系です。

スケジュール入力の際、
開始予定/終了予定/見積時間の3要素で決めると思うのですが、
2つが埋まれば残り1つは自動的に決まるじゃないですか?

こんな感じ↓

入力項目
開始予定と終了予定 会議など拘束時間がわかっているもの
終了予定と見積時間 締切、電車の到着時刻基準で検索
開始予定と見積時間 自分主体で組む予定、電車の発車時刻基準で検索

なのに普通のExcelだといちいち3つ目も入力しなきゃいけない...

こういう頻出動作が生む微弱なストレスが
塵も積もればなんとやらで地味に負荷をかけている
ものです。
この手の無意識レベルのストレスダイエットをすごく大事だと思っているので作りました。

ご自由にお使いください!

概要

タイトルの通り、
「開始予定/終了予定/見積時間のうち、どれか2つが埋まったら残りの1つを自動計算する」

これだけです。

コード

シートモジュール

Const Col見積 = "G"
Const Col開始 = "H"
Const Col終了 = "I"

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Select Case Target.Column
        Case Is = CNumAlp(Col開始), CNumAlp(Col終了)
            Call 四桁入力したら時刻に変換(Target)
            Call 見積等計算(Target)
    End Select
End Sub

標準モジュール

Const Col締切 = "F"
Const Col予定 = "F"
Const Col見積 = "G"
Const Col開始 = "H"
Const Col終了 = "I"
Const Col完了 = "J"

Public flag As Boolean

Sub 見積等計算(ByVal Target As Range)
  On Error Resume Next
  If flag = False Then: GoTo Cancel
  
  With Target
  Select Case .Column
    Case Is = CNumAlp(Col見積)                 '見積入力時
      If IsNumeric(.Value) = False And .Value <> "" Then
          MsgBox "数値を入力してください"
      ElseIf Cells(.Row, Col見積).Value <> "" Then                                        '見積時間列が空白でなければ
        If Cells(.Row, Col開始).Value <> "" And Cells(.Row, Col終了).Value = "" Then      '開始時刻が決まっており、終了時刻が未定なら
          Cells(.Row, Col終了).Value = _
            DateAdd("n", Cells(.Row, Col見積).Value, Cells(.Row, Col開始).Value)          '終了時刻を計算する
        ElseIf Cells(.Row, Col終了).Value <> "" And Cells(.Row, Col開始).Value = "" Then  '終了時刻が決まっており、開始時刻が未定なら
          Cells(.Row, Col開始).Value = _
            DateAdd("n", Cells(.Row, Col見積).Value * (-1), Cells(.Row, Col終了).Value)   '開始時刻を計算する
      End If
      End If
  
    Case Is = CNumAlp(Col開始)                '開始入力時
      If IsDate("01/01/01 " & Format(.Value, "hh:mm:dd")) = False And .Value <> "" Then
          MsgBox "時刻を入力してください"
      ElseIf Cells(.Row, Col見積).Value = "" And _
             Cells(.Row, Col終了).Value <> "" Then
          Cells(.Row, Col見積).Value = _
              DateDiff("n", Cells(.Row, Col開始).Value, Cells(.Row, Col終了).Value)
      ElseIf Cells(.Row, Col見積).Value <> "" And _
             Cells(.Row, Col終了).Value = "" Then
          Cells(.Row, Col終了).Value = _
              DateAdd("n", Cells(.Row, Col見積).Value, Cells(.Row, Col開始).Value)
         End If
  
    Case Is = CNumAlp(Col終了)               '終了入力時
      If IsDate("01/01/01 " & Format(.Value, "hh:mm:dd")) = False And .Value <> "" Then
          MsgBox "時刻を入力してください"
      ElseIf Cells(.Row, Col見積).Value = "" And _
         Cells(.Row, Col開始).Value <> "" Then
          Cells(.Row, Col見積).Value = _
              DateDiff("n", Cells(.Row, Col開始).Value, Cells(.Row, Col終了).Value)
      ElseIf Cells(.Row, Col見積).Value <> "" And _
             Cells(.Row, Col開始).Value = "" Then
          Cells(.Row, Col開始).Value = _
              DateAdd("n", Cells(.Row, Col見積).Value * (-1), Cells(.Row, Col終了).Value)
      End If
  End Select
  End With
Cancel:
End Sub

Function CNumAlp(va As Variant) As Variant '列文字⇔数値を相互変換する関数
    '引用元:https://ateitexe.com/change-alphabet-integer/
  Dim al As String
 
  If IsNumeric(va) = True Then '数値だったら
    al = Cells(1, va).Address(RowAbsolute:=False, ColumnAbsolute:=False) '$無しでAddress取得
    CNumAlp = Left(al, Len(al) - 1)
  Else 'アルファベットだったら
    CNumAlp = Range(va & "1").Column '列番号を取得
  End If
End Function

コードの解説

シートモジュール:Changeイベント

ここでやるのは
Call 見積等計算(Target)で標準モジュールを呼び出すだけです。
(Target)というのはChangeイベントで変更したセルを渡すものになります。

Call 四桁入力したら時刻に変換(Target)

こちらは以前紹介した別のマクロを呼び出すものです。

yoshino-ya.hatenablog.com


ちなみにこちらで出てきた伏線

Case .Value = "": flag = False '見積等計算プロシージャで自動計算させない
こちらは今回のもの単独では意味がありませんが、
別のプロシージャで、時刻の計算を行うのを防ぐためにある行です。

これが今回の見積等計算プロシージャです。


標準モジュール

変数宣言:列の指定 ※ここは人それぞれ設定が必要です

モジュールの先頭に宣言すると、そのモジュール内の共用変数になります。

接頭語にPublicをつけると他のモジュールでも共用化され、
Constをつけると定数として宣言できます。
行数や列数の指定や、定型文などに使えます。

Const Col見積 = "G"
Const Col開始 = "H"
Const Col終了 = "I"

Public flag As Boolean

プロシージャ名(ByVal Target As Range)のByVal Target As Rangeって何ぞ?

シートモジュールから渡されたTarget(変更されたセル)に対し処理をします。
セルを格納する変数なのでRange型です。

ByValは値渡しの意で、
もう一つ参照渡しByRefというものがありますが、
詳しくはこちらをどうぞ Office TANAKA - Excel VBA Tips[参照渡しと値渡し]


そういえば、As~(~として)って中学?の英語でやりましたよね?
他にもIfやThen、Else、Each、in、Toなど、
こういう接続語や前置詞などは英語をやっている最中でも
こうしてプログラミングなどを通して使ってみて
その語のもつイメージなどを習得していくのは有効だよなー
と思っています。

英語が苦手な子にはプログラミングをさせよう!
(まあ僕はプログラミングの方が苦手でしたが)


条件分岐:列の埋まり具合で判別

おなじみSelect文で仕分けます。

Select Case .Column
  Case Is = CNumAlp(Col見積)

変更されたセルの列によって仕分けます。
CNumAlp(Col見積)という謎の関数は後述します。


If IsNumeric(.Value) = False And .Value <> "" Then
  MsgBox "数値を入力してください"

これは入力された値が数値でなく、空白だった際に処理する行です。


実行する場合は次のIf分で仕分けられます。
各行の説明はコメント文の通りです。
長ったらしいですが、やっていることは単純力作業です。

ElseIf Cells(.Row, Col見積).Value <> "" Then                                        '見積時間列が空白でなければ
  If Cells(.Row, Col開始).Value <> "" And Cells(.Row, Col終了).Value = "" Then      '開始時刻が決まっており、終了時刻が未定なら
    Cells(.Row, Col終了).Value = _
      DateAdd("n", Cells(.Row, Col見積).Value, Cells(.Row, Col開始).Value)          '終了時刻を計算する
  ElseIf Cells(.Row, Col終了).Value <> "" And Cells(.Row, Col開始).Value = "" Then  '終了時刻が決まっており、開始時刻が未定なら
    Cells(.Row, Col開始).Value = _
      DateAdd("n", Cells(.Row, Col見積).Value * (-1), Cells(.Row, Col終了).Value)   '開始時刻を計算する
End If

ユーザー定義関数:列文字⇔数値を相互変換する関数

CellsColumnで変数から列指定をする際、

例えばJ1セルをしていする場合、

Cells(1,”J")

直接入力の場合はを指定できるのですが、

c="J"
Cells(1,c)

このように一旦変数に格納した列の文字列はCellsに入れるとエラーになります。

変数を介して指定する場合は数値でなれけばなりません。

ここで問題です。
「J」ってアルファベットの何番目?

僕は♪ABCの歌を歌わないと出てきません。

これを列番号の文字列を1列目から数えて何列目かなんて
いちいち数えてられませんし、コードが読みづらいですよね?


そこで素晴らしい変換ツールを作成されている方がいたので拝借しました。 ateitexe.com

これをシートモジュールにも標準モジュールにも組み込んで、
列による条件分岐文を書きやすく、見やすいものにできました!

残課題:複数セルをまとめて変更すると変なポップアップが出る

例えば開始、終了を同時に選択した状態で変更・削除すると
「時刻を入力してください」と言われます。

とは言え一応使えると言えば使えるので大目に見てやってください、、、

個人的感想

多重If文は書いてて楽しくないです
もっとスマートにできないかな、、、