「更新ボタン」があるから事故が起きる。Web APIとVBAで”正常性バイアス”を排除する「完全全自動ガントチャート」の作り方【新春連載：「卒Excel」ロードマップ 完結編】
※この記事は、筆者（上野）の過去の個人的な実体験に基づき、製造業におけるデータ活用の課題と「伴走支援」の重要性について考察したものです。ケーエスピー株式会社の公式な見解や、特定の企業様（過去の在籍企業を含む）を批判・評価する意図は一切ございません。
こんにちは、システムエンジニアの上野です。
全3回でお届けしている「卒Excel」ロードマップ、いよいよ完結編です。 今回は、私が製造業の現場にいた頃に作成し、実際に運用していた「ガントチャート」のコードを公開します。一部加筆していますが。
テーマは、「人間の『だろう運転』を、技術で強制的に排除する」です。
1. 「更新ボタン」は、責任の空白地帯を生む
システム開発のセオリーでは、画面のデータを最新にするための「更新（Refresh）」ボタンをつけるのが正解とされています。 しかし、現場において、このボタンは「事故の元」でしかありません。
なぜなら、更新ボタンは「いつでも押せる」からです。 「入力が終わった後」でも、「見る前」でも、「保存する前」でも押せてしまう。 この「任意性」が、現場に恐ろしい心理的バイアスを生みます。
「誰かが押してくれてるだろう」という罠
忙しい朝、工程表を開いた現場リーダーはこう思います。
- 「まあ、担当の〇〇さんが入力した後に更新してるだろう」
- 「昨日誰かが保存した時点で、最新になってるだろう」
そうやって誰もボタンを押さず、「反映されていない（古い）バー」を見て指示を出し、段取りを間違える。
普段は押しているのにその日は話しかけられて、押し忘れたたまま、段取りを間違える。
これが現場で起きる事故の正体でした。
悪いのは、更新を忘れた人間ではありません。 「情報の鮮度を、人間の『意志』や『記憶』に委ねている設計」そのものが間違っているのだと思いました。
2. なぜPower Queryではなく、あえてVBAなのか
最近のExcelには「Power Query」という便利な機能があり、Web上のデータを取得したり、表を加工したりできます。 「祝日データの取得」や「ガントチャートの集計」も、Power Queryで可能です。
しかし、私はあえて使いませんでした。 なぜなら、Power Queryも結局は「クエリの更新」というアクションが必要だからです。
「カレンダーが黒い」というだけで、人は騙される
特に危険なのが「祝日設定」です。 Power Queryで祝日を取ってくる仕組みを作ったとして、その更新頻度は「年に1回（年末）」くらいでしょう。 断言しますが、そんな低頻度のルーチンワーク、現場の人間(私)は100%忘れます。
というより、引継ぎを忘れて、そのファイルを使う人が冷や汗をかくことになる自信がありました。
もし更新を忘れて年を越すと、どうなるか。 「成人の日（祝日）」が、カレンダー上で「平日（黒字）」のまま表示されます。
これを見た担当者は、何の疑いもなく「よし、1月13日（成人の日）に出荷しよう」と計画を立てます。あるいは、「今週は5日間フルで稼働できるな」と勘違いし、パンパンの製造予定を詰め込みます。
そして直前になって気づくのです。 「あれ、この日、休みじゃん……」
出荷トラックの手配ミス、あるいは無理な工程による現場の残業地獄。 これらはすべて、「カレンダーが最新ではなかった」ことから始まる悲劇です。
だから私は決めました。 「人間を信じるな。ファイルを開いた瞬間、強制的にカレンダーを最新にしろ」
（※イメージ図です。ナノバナナ（AI）で生成したら、壮大なサービス紹介風＆文字崩れが発生しましたが、雰囲気で感じ取ってください）
3. 【コード公開】これが「強制自動化」の実装だ
これからお見せするのは、「ユーザーに1クリックもさせない（判断させない）」ためのVBAコードです。
① 開いた瞬間、強制的に祝日を取りに行く
' GitHub上のAPIから、最新の祝日データを自動取得
Sub UpdateHolidayList()
' ...（省略）...
url = "https://holidays-jp.github.io/api/v1/" & y & "/date.json"
http.Open "GET", url, False
http.Send
' ...（取得したJSONを分解してシートに書き込む）...
End Sub
まず、Workbook_Open（ファイルを開いた瞬間）に、以下のコードが走ります。 ユーザーが「更新しよう」と思わなくても、Excelが勝手にWeb APIを叩きに行きます。
これにより、「来年の祝日設定」というタスク自体が消滅します。 人間が忘れていても、プログラムは忘れません。祝日は常に赤く染まり、そこに予定を入れようとすれば「あ、休みか」と直感的に気づけます。
② 入力した瞬間、強制的にバーを引き直す
次に、ガントチャートの描画です。 「入力が終わったら更新ボタンを押す」という運用は、「押し忘れ」を生みます。 そこで、「セルの中身が変わった（Enterキーを押した）瞬間」を検知して、その行のバーを即座に描き変えるVBAを組みました。
' セルが変更されたら、即座に描画処理を呼ぶ
Private Sub Worksheet_Change(ByVal Target As Range)
' ...（対象範囲外なら無視する判定）...
Call Gantt_Main(isct)
End Sub
これなら、「入力したのにバーが古い」という状態は、物理的に発生し得ません。 画面に見えているものが、常に正解です。
【実物公開】サンプルファイルをプレゼント
今回の記事で解説した「完全全自動ガントチャート」を、読者の皆様にプレゼントします。 コードはロックしていません。Alt + F11 を押して、中身を見てください。つたないコードですがご了承ください。。。
自分で作りたい人へ：全ソースコード公開
セキュリティの都合でファイルをダウンロードできない方や、コードを勉強したい方のために、全コードを掲載します。 以下の「▶」ボタンを押して、コードをコピーし、標準モジュールに貼り付けてください。
ソースコード
ステップ1：標準モジュール（計算の本体）
VBAの画面で「挿入」→「標準モジュール」を選び、以下のコードを貼り付けます。これが自動化の「脳みそ」部分です。
VB.Net
' ==============================================================================
' モジュール名：MainLogic
' 役割：祝日取得とガントチャート描画の「実行部隊」
' ==============================================================================
Option Explicit
' 【設定エリア】
Public Const COL_START_DATE As Long = 2 ' 開始日の列 (B列)
Public Const COL_END_DATE As Long = 3 ' 終了日の列 (C列)
Public Const COL_CAL_START As Long = 5 ' カレンダー開始列 (E列)
Public Const ROW_HEADER As Long = 10 ' カレンダーの日付行
Public Const SHEET_HOLIDAY As String = "祝日リスト"
' ------------------------------------------------------------------------------
' 機能1：Web APIから祝日を取得する
' ------------------------------------------------------------------------------
Sub UpdateHolidayList()
Dim ws As Worksheet
Dim http As Object
Dim url As String
Dim y As Long
Dim resText As String
Dim items As Variant
Dim oneItem As Variant
Dim datePart As Variant
Dim dateStr As String
Dim nameStr As String
Dim targetCell As Range
Dim successCount As Long
Dim dataCache As Object
Set dataCache = CreateObject("Scripting.Dictionary")
' シート準備
On Error Resume Next
Set ws = ThisWorkbook.Sheets(SHEET_HOLIDAY)
On Error GoTo 0
If ws Is Nothing Then
Set ws = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
ws.Name = SHEET_HOLIDAY
End If
Set http = CreateObject("MSXML2.XMLHTTP")
On Error Resume Next
successCount = 0
' APIから前後1年分の祝日を取得
For y = Year(Date) - 1 To Year(Date) + 1
url = "https://holidays-jp.github.io/api/v1/" & y & "/date.json"
http.Open "GET", url, False
http.Send
If http.Status = 200 Then
successCount = successCount + 1
resText = http.responseText
' 簡易JSONパース
resText = Replace(resText, "{", "")
resText = Replace(resText, "}", "")
resText = Replace(resText, """", "")
resText = Replace(resText, vbCr, "")
resText = Replace(resText, vbLf, "")
items = Split(resText, ",")
For Each oneItem In items
datePart = Split(oneItem, ":")
If UBound(datePart) >= 1 Then
dateStr = Trim(datePart(0))
nameStr = Trim(datePart(1))
If IsDate(dateStr) Then dataCache(dateStr) = nameStr
End If
Next oneItem
End If
Next y
On Error GoTo 0
Set http = Nothing
' 取得成功時のみ書き込み
If successCount > 0 Then
ws.Range("A:B").ClearContents
ws.Range("A1:B1").Value = Array("日付", "祝日名")
Set targetCell = ws.Range("A2")
Dim k As Variant
For Each k In dataCache.Keys
targetCell.Value = CDate(k)
targetCell.Offset(0, 1).Value = dataCache(k)
Set targetCell = targetCell.Offset(1, 0)
Next k
' 仕上げ（ソート等）
If ws.Cells(ws.Rows.Count, 1).End(xlUp).Row > 1 Then
ws.Range("A:B").Sort Key1:=ws.Range("A2"), Order1:=xlAscending, Header:=xlYes
ws.Range("A2", ws.Cells(ws.Rows.Count, 1).End(xlUp)).NumberFormatLocal = "yyyy/m/d"
End If
End If
End Sub
' ------------------------------------------------------------------------------
' 機能2：ガントチャートの描画メイン処理
' ------------------------------------------------------------------------------
Public Sub Gantt_Main(ByVal Target As Range)
On Error GoTo ErrorHandler
Application.ScreenUpdating = False
Application.EnableEvents = False
Dim calcMode As Long
calcMode = Application.Calculation
Application.Calculation = xlCalculationManual
Dim ws As Worksheet: Set ws = Target.Parent
Dim minDate As Date, maxDate As Date
Dim isHeaderChanged As Boolean
' 期間計算とヘッダー更新
Call Sub_CalcProjectScope(ws, minDate, maxDate)
Call Sub_UpdateHeader(ws, minDate, maxDate, isHeaderChanged)
' ヘッダーが変わった場合は全行再描画の対象にする
If isHeaderChanged Then
Dim lastRow As Long
lastRow = ws.Cells(ws.Rows.Count, COL_START_DATE).End(xlUp).Row
If lastRow > ROW_HEADER Then
Set Target = ws.Range(ws.Cells(ROW_HEADER + 1, 1), ws.Cells(lastRow, 1))
End If
End If
' 変更行のバーを描画
Call Sub_DrawRows(ws, Target)
CleanUp:
Application.Calculation = calcMode
Application.EnableEvents = True
Application.ScreenUpdating = True
Exit Sub
ErrorHandler:
Resume CleanUp
End Sub
' --- 以下、下請けプロシージャ ---
Private Sub Sub_CalcProjectScope(ByRef ws As Worksheet, ByRef outMin As Date, ByRef outMax As Date)
Dim vMin As Variant, vMax As Variant
vMin = Application.WorksheetFunction.Min(ws.Columns(COL_START_DATE))
vMax = Application.WorksheetFunction.Max(ws.Columns(COL_END_DATE))
If vMin = 0 Then vMin = Date
If vMax = 0 Then vMax = vMin + 30
outMin = CDate(vMin) - 2
outMax = CDate(vMax)
End Sub
Private Sub Sub_UpdateHeader(ByRef ws As Worksheet, ByVal sDate As Date, ByVal eDate As Date, ByRef outChanged As Boolean)
Dim currentStart As Variant
Dim daysNeeded As Long
' (省略可読性のために一部ロジックはDLファイル参照とするか、ここに全掲載するか要判断ですが、
' 今回は「コピペで動く」が趣旨なので全ロジックを含めます)
currentStart = ws.Cells(ROW_HEADER, COL_CAL_START).Value
daysNeeded = (eDate - sDate) + 3
If daysNeeded < 30 Then daysNeeded = 30
Dim currentCols As Long
currentCols = ws.Cells(ROW_HEADER, ws.Columns.Count).End(xlToLeft).Column - COL_CAL_START
If currentCols < 0 Then currentCols = 0
If Not IsDate(currentStart) Then
outChanged = True
ElseIf CDate(currentStart) <> sDate Or currentCols < daysNeeded Then
outChanged = True
Else
outChanged = False
Exit Sub
End If
' ヘッダーの再構築処理
Dim endCol As Long: endCol = COL_CAL_START + daysNeeded
Dim maxCleanCol As Long: maxCleanCol = COL_CAL_START + currentCols + 100
' 掃除
If maxCleanCol > endCol Then
ws.Range(ws.Cells(ROW_HEADER, endCol + 1), ws.Cells(ws.Rows.Count, maxCleanCol)).Clear
End If
ws.Range(ws.Cells(ROW_HEADER, COL_CAL_START), ws.Cells(ws.Rows.Count, endCol)).FormatConditions.Delete
' 日付セット
ws.Cells(ROW_HEADER, COL_CAL_START).Value = sDate
With ws.Range(ws.Cells(ROW_HEADER, COL_CAL_START), ws.Cells(ROW_HEADER, endCol))
.Resize(1, 1).Value = sDate
.DataSeries Rowcol:=xlRows, Type:=xlChronological, Date:=xlDay, Step:=1
.NumberFormatLocal = "m/d"
.ColumnWidth = 6
.HorizontalAlignment = xlCenter
.Borders.LineStyle = xlNone
End With
' 休日判定と色塗り・点線
Dim holRange As Range
On Error Resume Next
Set holRange = ThisWorkbook.Sheets(SHEET_HOLIDAY).Range("A:A")
On Error GoTo 0
Dim c As Long, currDate As Date
Dim redRange As Range
For c = COL_CAL_START To endCol
With ws.Cells(ROW_HEADER, c).Borders(xlEdgeRight)
.LineStyle = xlDot
.ColorIndex = 15
End With
currDate = ws.Cells(ROW_HEADER, c).Value
Dim isRed As Boolean: isRed = False
If Weekday(currDate) = vbSaturday Or Weekday(currDate) = vbSunday Then isRed = True
If Not isRed And Not holRange Is Nothing Then
If Application.CountIf(holRange, currDate) > 0 Then isRed = True
End If
If isRed Then
If redRange Is Nothing Then Set redRange = ws.Cells(ROW_HEADER, c) Else Set redRange = Union(redRange, ws.Cells(ROW_HEADER, c))
End If
Next c
If Not redRange Is Nothing Then redRange.Interior.Color = RGB(255, 220, 220)
ws.Range(ws.Cells(ROW_HEADER, COL_CAL_START), ws.Cells(ROW_HEADER, endCol)).Borders(xlEdgeBottom).LineStyle = xlNone
End Sub
Private Sub Sub_DrawRows(ByRef ws As Worksheet, ByVal Target As Range)
Dim targetRowRange As Range
Dim r As Range
Set targetRowRange = Intersect(Target.EntireRow, ws.UsedRange)
If targetRowRange Is Nothing Then Exit Sub
For Each r In targetRowRange.Rows
If r.Row > ROW_HEADER Then Call Sub_DrawSingleRow(ws, r.Row)
Next r
End Sub
Private Sub Sub_DrawSingleRow(ByRef ws As Worksheet, ByVal r As Long)
Dim lastCol As Long
lastCol = ws.Cells(ROW_HEADER, ws.Columns.Count).End(xlToLeft).Column
If lastCol < COL_CAL_START Then Exit Sub
Dim drawRange As Range
Set drawRange = ws.Range(ws.Cells(r, COL_CAL_START), ws.Cells(r, lastCol))
' 書式コピー＆クリア
ws.Range(ws.Cells(ROW_HEADER, COL_CAL_START), ws.Cells(ROW_HEADER, lastCol)).Copy
drawRange.PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False
' バー描画
Dim sVal As Variant, eVal As Variant, calStart As Date
sVal = ws.Cells(r, COL_START_DATE).Value
eVal = ws.Cells(r, COL_END_DATE).Value
If IsDate(sVal) And IsDate(eVal) And sVal > 0 And eVal >= sVal Then
calStart = ws.Cells(ROW_HEADER, COL_CAL_START).Value
Dim startPos As Long, barLen As Long
startPos = COL_CAL_START + (CDate(sVal) - calStart)
barLen = (CDate(eVal) - CDate(sVal)) + 1
If startPos < COL_CAL_START Then
barLen = barLen - (COL_CAL_START - startPos)
startPos = COL_CAL_START
End If
If startPos <= lastCol And barLen > 0 Then
If (startPos + barLen - 1) > lastCol Then barLen = lastCol - startPos + 1
ws.Cells(r, startPos).Resize(1, barLen).Interior.Color = RGB(128, 128, 128)
End If
End If
' 下線
With drawRange.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 15
.Weight = xlThin
End With
End Sub
ステップ2：シートモジュール（入力の監視）
左側のツリーから、ガントチャートにしたいシート（例：Sheet1）をダブルクリックして、以下のコードを貼ります。 これが「入力した瞬間（更新ボタンなし）に動く」ためのスイッチです。
VB.Net
Private Sub Worksheet_Change(ByVal Target As Range)
' 開始日・終了日の列が変更された時だけ反応する
Dim isct As Range
Set isct = Intersect(Target, Range(Columns(COL_START_DATE), Columns(COL_END_DATE)))
If isct Is Nothing Then Exit Sub
If isct.Cells(1).Row <= ROW_HEADER Then Exit Sub
' 標準モジュールの描画処理を呼び出す
Call Gantt_Main(isct)
End Sub
ステップ3：ThisWorkbookモジュール（開いた瞬間の更新）
左側のツリーから「ThisWorkbook」をダブルクリックして、以下のコードを貼ります。 これが「開いた瞬間に祝日APIを叩く」ためのスイッチです。
VB.Net
Private Sub Workbook_Open()
' ファイルを開いた瞬間に、祝日更新を実行
Call UpdateHolidayList
End Sub
結論：DXは「人間の弱さ」を認めることから始まる
全3回にわたり、「卒Excel」について語ってきました。 最終回で伝えたかったのは、「ツールを入れれば解決するというわけではない」自社のデータについて、自分たちで管理することが大切だということです。
新しいツールを入れることが必ずしも効率を上げるわけではなく、自分たちのデータをどのように表現すれば使いやすくなるのかを考えること。これこそがDXの神髄だと思います。
ぜひExcelを使い倒して自社の入力データと出力データの整理を進めてください。いつか、システムを導入する際に役立つことになるとおもいます。
私は、製造現場の「もったいない」を知るSEとして、その「めんどくさい」に隠された「お宝データ」を発掘し、仕組み化するお手伝いをしています。
もし、「ウチの現場も『押し忘れ』で事故が絶えない…」とお悩みなら、一度KSPにご相談ください。 人間の弱さを前提とした、現場に優しい仕組みづくりをお手伝いいたします。
関連記事
「マニュアル通りの設定」が正解とは限らない。ミシン修理で学んだ、システムを“人になじませる”という技術
