ひとりマーケティングのためのデータ分析

TOOLS / PROBABILISTIC INFERENCE

複雑な因果関係をネットワーク図にモデル化し、チェックボックスで推論する。
Excelで作るベイジアンネットワーク確率推論ツール。

チェックボックスのON/OFFだけで、確率が連動して変わる。

HOME TOOLS ベイジアンネットワーク

2026/4/26

晴花

HARUKA

観測できるのは一部だけ。それでも全体を推論できる——それがベイジアンネットワークの強さ。

ベイジアンネットワークとは

ベイジアンネットワークは、

因果関係を確率により記述するグラフィカルモデルの1つで、複雑な因果関係の推論を有向非巡回グラフ構造により表すとともに、個々の変数の関係を条件つき確率で表す確率推論のモデル

と説明されるものです（Wikipedia）。

深淵な領域ですが、ここでは最も単純な類のネットワークを触っていきます。 単純であれ、ハマればなかなかに恵沢を享受できるのがベイジアンネットワークの良いところです。 なお、ここでいう単純とは、すべて2値の変数・少ないノード・構造は所与かつ簡素、といった特徴をもつものを指して言います。

DAG
有向非巡回グラフ。ノード間の因果関係を矢印で表し、ループを持たない構造
CPT
条件付き確率表。親ノードの状態ごとに子ノードの確率を定義したテーブル

Excel 上でベイジアンネットワークを組み立てる一例として、最も単純な類——すべて2値の変数・少ないノード・構造は所与かつ簡素——を扱います。 工程の一部でやむをえずマクロを使用します。効率を至上とするなら専用ツール（Weka等）での処理が最善です。

00

状況設定 — 審査部門の13人

13人のメンバーを擁する、ある会社の審査部門を想定します。

審査部門・13人のメンバー

審査部門には営業部門より"事案"が投入されます。審査部門は、この事案に対し ACCEPT（以下"YES"）か REJECT（以下"NO"）を返すのが仕事です。

営業部門から審査部門へ事案が投入される

投入された事案は、まず「第3層」のメンバーおのおのによって独立して精査されます。

第3層が事案を独立して審査

結果（YES, NO）はすべて直属の上長である「第2層」に上がります。3人の上長は、直属の部下から上がってきた結果を自分の裁量のもとに参考にしながら、 こちらも独自に判断を下します。

第2層が第3層の結果をもとに判断

第2層が下した判断はそれぞれ「第1層」に上がります。この位置にいる「リーダー」もまた、自分の裁量のもとに第2層の結果のみを参考にして YES か NO を量ります。これを、部門の最終判断として営業部門に返します。

第1層（リーダー）が最終判断を下す

事案ごとにメンバーおのおのの判断を記録し、YES・NO の割合（事前確率〔第3層〕あるいは条件付き確率〔第2層・第1層〕）を一覧にまとめたものが図です。

各メンバーの事前確率および条件付き確率表（CPT）

これにより、たとえば「LEADER 以外の全員が YES をつけた」ことを観測したとき、LEADER がどう出るかを量れます。 すべての変数の同時確率は次式で表されます。

P(Al,An,J,N,H,B,Sal,Li,T,Sar,C,E,Le)=P(Al)P(An)P(J)P(N)P(H)P(B)P(Sal)P(Li)P(T)P(Sar|Al,An,J,N)P(C|H,B,Sal)P(E|Li,T)P(Le|Sar,C,E)

右辺に値を代入すると

=0.5×0.45×0.6×0.5× 0.35×0.7×0.35× 0.5×0.5× 0.9×0.95×0.1× 0

となり、この場合 LEADER が NO の判断をつけることは皆無（0%）と推測できます。

より現実的に、限られたメンバーの結果のみを観測できる場合も試せます。たとえば「Hana が YES をつけたことで、LEADER の YES の確率はどう変動するか」を探るには図の式で求めます。

HanaがYESの場合のLEADER YES確率を求める条件付き確率式

他のメンバーの結果が不透明な場合、そのままでは計算が複雑になりますが、こうした不足を解決するツールが存在します。たとえば「Weka」を使えば、ネットワークを GUI で直感的にデザインし、確率を即座に確認できます。

Weka：ベイズネットワークエディタ
Weka ベイズネットワークエディタ
Weka：Hana=YESのエビデンスを付けた場合の確率変動
Weka：Hana=YESのエビデンスを付けた場合の確率変動

このページでは、こうした柔軟な推論のしくみを Excel 上で組み立てます。

01

用途ごとにシートをわける

ひとつのシートにさまざまな要素が混在すると窮屈になるため、シートを分けて使います。具体的には、NETWORK・CPT・TABLE の3枚のシートを用意します。

NETWORK・CPT・TABLEの3枚のシートを挿入
02

シート「NETWORK」

しばらくはシートNETWORK上での処理をすすめます。

まず任意の図形を使って、各メンバー（以下「ノード」）がセルの枠に上手に填まるように調整しつつ（「配置」機能"枠線に合わせる"）ネットワークを描画します。ここではノードは楕円を、親子関係はコネクタで描いています。

「親」と「子」

有向のネットワークにいう親は矢印の始点のノードが、子は矢印の終点のノードが該当します。組織における職位と混同しやすい点に注意してください。

楕円とコネクタでベイジアンネットワーク（DAG）を描画

適当なノードからフォームコントロールのチェックボックスを配置します。コントロールを枠線にピタリとはまるよう調整しておくと、コピペや見栄えの上で好ましいです。

コントロールのラベルをとりうる2値の一方（ここではYES）に変更します。そして、コントロールの名前を変更します（デフォルトの「チェック○○」では識別しにくいため）。 後述のコードにて、プロシージャ名を〔checkBox〕＋〔メンバーの名前〕＋〔2値のいずれか〕の先頭小文字のキャメルケースで書いているので、 チェックボックスの名前もこれに合わせておきます。

晴花

比較的新しいバージョンの Excel は、チェックボックスの仕様変更があってか、ラベルが廃止。 この場合、隣のセルなど別のセルにラベルを模して文字列を書き入れる必要がある。

チェックボックスを配置
フォームコントロールのチェックボックスを配置
ラベルをYESに変更
ラベルをYESに変更
コントロール名をキャメルケースで変更
コントロール名をキャメルケースで変更

同様にして2値の残された方のチェックボックスも設置します。コントロールの名前も先の規則で変更します。

NOチェックボックスを追加・名前を変更

2つのチェックボックスを選択してコピーし、残りのすべてのノードにペーストします。コントロール名の変更も忘れずに済ませます。

チェックボックスをすべてのノードの側に配置

ネットワーク図と被らない位置（ここではT列）にチェックボックスの状態を管理するための2元表をつくります。縦方向にノード名、横方向にとりうる2値を並べ、表の中には初期値としてFALSEを置いておきます。

チェックボックスの状態を管理する2元表（見出し） チェックボックスの状態を管理する2元表（FALSEで初期化）

管理表とチェックボックスをリンクさせます。たとえば「checkBoxAliceYes」は「Alice」と「YES」の交点、セルU2とリンクさせます。これをすべてのコントロールについて繰り返します。

チェックボックスとセルをリンク
03

シート「CPT」

ここからしばらくCPTシートの処理に移ります（CPT: Conditional Probability Table）。このシートには、導入で説明した3層ごとに区別して確率表を配置します。図のような見出しを置きます。

CPTシートに3層ごとの見出しを配置

上のリンクからデータをコピーし、内容をセルA2にコピペすると第3層から第1層まですべての確率を埋めることができます （ただし第2層・第1層は「結合」列を別途埋める必要あり。次のステップで説明）。まず第3層すべてを埋めたのが図です。

第3層の事前確率を配置

つづいて第2層を埋めます。こちらは親をもつ条件付き確率なので、YES・NOについてすべての組み合わせを埋める必要があります（「Extension：とりうる値のすべての組み合わせをつくる」を参照）。

また2つ以上の条件をもつ場合、後の工程でこの表を参照する際の処理を単純化するために、「結合」という作業列をあわせて設置します。この「結合」列には、左の4つのノードの値をアンパサンド"&"で結合します（たとえばセルH4では=D4&E4&F4&G4）。

第2層の条件付き確率表と「結合」列の見出し 「結合」列に親ノードの値を&で結合した文字列を設定
Extension — とりうる値のすべての組み合わせをつくる

DEC2BIN関数で可能な場合

2値の場合、パターンは親の数をnとしたとき2nあります。たとえばノードSarahは親を4つもっているため、組み合わせは24パターンとなります。これを愚直に1パターンずつ考えるのはたいへんなので、

2^4=16パターンをどのようにつくるか

0から24-1までの値をつくり（下図では降順で作成）、

  • =DEC2BIN(A2, n)

で2進数に変換します。

DEC2BIN関数で10進数を2進数に変換

さらにMID関数などで2進数を1文字ずつにバラします。ノードがとりうる2値はYES, NOなので、たとえば1をYES, 0をNOに置換すればSarah表を埋めるすべてのパターンが用意できます。

10進数→2進数→1文字ずつ分割→YES/NOに置換

DEC2BIN関数では十分でない場合

DEC2BIN関数は仕様上、1番目の引数が511までしか対応できません。それを超える場合は次のリンク先の方法で対応できます。

この方法であれば後述の結合分布をつくるときでも困りません。また、上記の方法でも対応できない場合や2値を超える場合、あるいは2値や3値が混在するような場合には、目的にかなうマクロを組んで処理するのがベターです。

第2層の残る2人についても同様に表を設置します。

第2層の残り2ノード（Clarice・Enid）の条件付き確率表

最後に第1層を完成させます。こちらも親をもつノードなので、つくりかたは第2層の場合と同じです。

第1層（LEADER）の条件付き確率表
04

シート「TABLE」

ここからTABLEシートでの作業に移ります。このシートでは13の変数がとりうるすべての組み合わせ、すなわち同時分布をつくります。

すべてのノード名を先頭行に見出しとして配置し、その末端にP( )で括ったノード名を、さらに末尾にギリシア文字の"パイ"を置きます。P( ) で括った列はCPTシートから条件を満たす確率を引っぱってくる場所として、"パイ" 列はそれらの同時確率を周辺化する場所として利用します。

見出し１ A1:M1
TABLEシート：左半分の見出し（ノード名）を作成
見出し２ N1:Z1
TABLEシート：右半分の見出し（P()付きノード名）を作成
見出し３ AA1
TABLEシート：末尾にΠ列を追加

13ノードがとりうる値のすべての組み合わせを用意します。この例では213=8192パターンあるため、機械的に用意するしかありません（「Extension: とりうる値のすべての組み合わせをつくる」参照）。あるいはあらかじめ用意されたデータを開き、セルA2にコピペ（形式を選択して貼り付け：テキスト）してもかまいません。

2^13=8192の組み合わせをA2からコピペ

この時点で、この表をExcelのテーブル化（先頭行は見出し）しておきます。後の管理の上でさまざまな利点があります。

8192行の表をExcelテーブルに変換

見出し直下の行、最初のノードのとる値と対応する確率をCPTシートから引っぱります。Aliceを筆頭とする第3層のノードは、ネットワークにおいて親ノードをもちません。したがってテーブル上の当該行のAliceの値（セル A2）を参照して、この値の場合の確率をピックアップする式をつくります。

  • CELL N2=IF([@Alice]="YES", CPT!$A$4, CPT!$B$4)

なお上の式の[]の部分は構造化参照と呼ばれるテーブル固有の参照ルールです。通常の式を組み立てる感覚でセルA2をクリックした時点で、自然とこのような表示になります。

P(Alice)列の式を入力 AliceはネットワークのDAGで親ノードをもたない第3層 AliceのCPTシートへの参照の対応関係

テーブル上で入力された計算式は、この列に自動でフィルされます。したがってこれ以降の作業も、見出しの直下の行のみをターゲットにしていきます。第3層の残るノード（Annie〜Tricia）を処理します。

  • CELL O2=IF([@Annie]="YES", CPT!$A$8, CPT!$B$8)
  • CELL P2=IF([@Johanna]="YES", CPT!$A$12, CPT!$B$12)
  • CELL Q2=IF([@Nickie]="YES", CPT!$A$16, CPT!$B$16)
  • CELL R2=IF([@Hana]="YES", CPT!$A$20, CPT!$B$20)
  • CELL S2=IF([@Beth]="YES", CPT!$A$24, CPT!$B$24)
  • CELL T2=IF([@Sally]="YES", CPT!$A$28, CPT!$B$28)
  • CELL U2=IF([@Liz]="YES", CPT!$A$32, CPT!$B$32)
  • CELL V2=IF([@Tricia]="YES", CPT!$A$36, CPT!$B$36)
第3層全ノードのP()列を入力

つづいて第2層の最初のノードSarahを処理します。この層のノードは親ノードをもっているため、テーブル上の当該行の親ノードの値（A2, B2, C2, D2）と自身の値（セル J2）をともに参照して確率をピックアップします。

  • CELL W2=INDEX(CPT!$I$4:$J$19, MATCH([@Alice]&[@Annie]&[@Johanna]&[@Nickie], CPT!$H$4:$H$19, 0), MATCH([@Sarah], CPT!$I$3:$J$3, 0))
P(Sarah)列の式を入力 SarahはDAGで親ノードをもつ第2層 SarahのCPTシートへの参照の対応関係（INDEX+MATCH）

第2層の残るノードと第1層のノード（Clarice・EnidおよびLEADER）も処理します。

  • CELL X2=INDEX(CPT!$H$23:$I$30, MATCH([@Hana]&[@Beth]&[@Sally], CPT!$G$23:$G$30, 0), MATCH([@Clarice], CPT!$H$22:$I$22, 0))
  • CELL Y2=INDEX(CPT!$G$34:$H$37, MATCH([@Liz]&[@Tricia], CPT!$F$34:$F$37, 0), MATCH([@Enid], CPT!$G$33:$H$33, 0))
  • CELL Z2=INDEX(CPT!$P$4:$Q$11, MATCH([@Sarah]&[@Clarice]&[@Enid], CPT!$O$4:$O$11, 0), MATCH([@LEADER], CPT!$P$3:$Q$3, 0))
第2層残り2ノードと第1層（LEADER）のP()列を入力

"パイ" 列を処理します。パターンごとにすべてのPを掛け合わせた値を求めるため、

  • CELL AA2=PRODUCT(テーブル1[@[P(Alice)]:[P(LEADER)]])

で対処します。

Π列：PRODUCT関数で全P()列を掛け合わせる
Extension — 確率をどのように求めるか

条件付き確率の定義式

頁頭の設定——すなわちHana（H）がYESをつけたことによって、LEADER（Le）のYESの確率はどうなるかは、下式の条件付き確率で求めます。

P(Le|H)=P(Le, H)/P(H)

このとき、分子は下図上段の式で、分母は下図下段の式で計算できます。

P(Le, H)=Σ P(Al,An,J,N,H,B,Sal,Li,T,Sar,C,E,Le) P(H)=Σ P(Al,An,J,N,H,B,Sal,Li,T,Sar,C,E,Le)

テーブルにフィルタをかけて確率を積み上げる

先につくったテーブルは、これらの式を利用することを前提として設置したものです。どういった処理をおこなうのかを示すため、先のテーブルに集計行を用意して話を進めます。このテーブルはとりうるすべての値の組み合わせをカバーしているので、"パイ"列の合計も1となっているはずです。

テーブルに集計行を加える

分子の式はLEADERとHanaの同時確率、題意に沿えばLEADERとHanaがともにYESを返す確率です。これは、テーブルのHanaとLEADER列（Pで括っていない方！）のフィルタをともに「YES」でONにしたときの「集計」値と一致します。

分母の式はHanaのみの確率、題意に沿えばHanaがYESを返す確率です。これは、HanaとLEADERに掛かっている2つのフィルタのうち、LEADERのフィルタを解除したときの「集計」値と一致します。

つまり、0.16997 / 0.35 = 0.4856 とこの場合の解答を導くことができます。

テーブルのHana・LEADERのフィルタをYESでON：分子に対応 テーブルのLEADERのフィルタを解除：分母に対応
05

ふたたび、シート「NETWORK」〜完成

上の Extension で見た計算の一部をシートNETWORK上に実装します。すでにつくったチェックボックスの管理表と少し離して、ノードと同じ行数 × 変数のとりうる値の列数 をセル範囲とする以下のグレーの区画を充てます。

セルU17:V29をSUMIFS文字列の生成エリアとして利用

セルU17, V17に次式を入力し、ノードの数だけ下方にコピーします。

  • CELL U17=IF(U2, "テーブル1[" & T2 & "]," & CHAR(34) & $U$1 & CHAR(34), "")
  • CELL V17=IF(V2, "テーブル1[" & T2 & "]," & CHAR(34) & $V$1 & CHAR(34), "")

管理表の当該セルの内容がTRUEになったときのみ文字列（SUMIFS関数の引数として利用）を表示します。この文字列をマクロで読み取って、自身のフィルタをONにする目的で使用します。

SUMIFS関数の引数となる文字列をIF式で生成

チェックボックスの横に確率を表示するパーツをつくります。 任意のノードの横にまず1セット、文字色・有効桁など書式を設定したとりあえずの値「0.5」を設置します。これを残りのすべてのノードにコピペします。

確率表示パーツ（書式付き0.5）を1セット作成
確率表示パーツ（書式付き0.5）を1セット作成
確率表示パーツをすべてのノードにコピー
確率表示パーツをすべてのノードにコピー

確率パーツを配置したセルすべてを選択します。これらにExcelの条件付き書式のデータバーを、min:0〜max:1の設定で加えます。

確率表示セルをすべて選択
確率表示セルをすべて選択
条件付き書式のデータバー（min:0〜max:1）を設定
条件付き書式のデータバー（min:0〜max:1）を設定

下のコードを標準モジュールにコピペします。

頭に▼印のついたConstステートメント群やFunction群は修正の負担を減らすために設けています。このマクロは変数のとりうる値が2値までの対応ですが、このページ以外の環境で利用する場合は、これらを状況に合ったものに変更することで動作します。ただしその場合、チェックボックスとリンクさせるプロシージャ群の名前もそれぞれ変更する必要があります。 


Option Explicit

' ==============================================================================
' [ツール名] ベイジアンネットワーク確率推論マクロ
' [機能]     GUI（チェックボックス）の操作に連動して条件付き確率を動的に計算・更新
' [参照元]   hitorimarketing.net/tools/bayesian-network.html
' [作成/更新] hawcas / 2018, Refactored 2026
' ==============================================================================

' ------------------------------------------------------------------------------
' グローバル変数
' ------------------------------------------------------------------------------
Dim CheckBoxID As Integer
Dim CheckBoxBIN As Integer
Dim Numerator As String
Dim Denominator As String

' ------------------------------------------------------------------------------
' 定数設定（※他事例へ転用する際の変更箇所）
' ------------------------------------------------------------------------------
' ▼ "NETWORK" シートの構造
Const TOTALNODE As Integer = 13 ' ノードの総数
Const TRUEFALSELIST As String = "U2:V14" ' チェックボックス管理表のセル範囲
Const FORMULASTRINGSLIST As String = "U17" ' SUMIFS式生成用テーブルの左上セル位置

' ▼ "TABLE" シートの構造
Const TABLENAME As String = "テーブル1" ' データテーブル名
Const HEADWORDOFSUBTOTAL As String = "Π" ' 総積（同時確率）を計算している列の見出し名


' ==============================================================================
' パラメータ取得用関数群
' ==============================================================================

' ------------------------------------------------------------------------------
' ▼ ノード名の取得
' ------------------------------------------------------------------------------
Private Function GetCheckBoxOwner(ByVal checkbox_id As Integer) As String
    GetCheckBoxOwner = Application.WorksheetFunction.Choose(checkbox_id, _
        "Alice", "Annie", "Johanna", "Nickie", _
        "Hana", "Beth", "Sally", _
        "Liz", "Tricia", _
        "Sarah", "Clarice", "Enid", _
        "LEADER")
End Function

' ------------------------------------------------------------------------------
' ▼ 確率表示セルのアドレス取得（ノード名と対応）
' ------------------------------------------------------------------------------
Private Function GetMarginsAddress(ByVal checkbox_id As Integer) As String
    GetMarginsAddress = Application.WorksheetFunction.Choose(checkbox_id, _
        "M3", "J1", "G3", "E6", _
        "D14", "E19", "H22", _
        "O21", "Q13", _
        "J8", "H16", "N16", _
        "K13")
End Function

' ------------------------------------------------------------------------------
' ▼ 2値（YES/NO）の取得
' ------------------------------------------------------------------------------
Private Function GetCheckBoxValue(ByVal checkbox_bin As Integer) As String
    GetCheckBoxValue = Application.WorksheetFunction.Choose(checkbox_bin, "YES", "NO")
End Function


' ==============================================================================
' 計算式の動的生成プロセス
' ==============================================================================

' ------------------------------------------------------------------------------
' 計算式の作成（自ノード含む：分子部分）
' ------------------------------------------------------------------------------
Private Function GetTextStrings(ByVal checkbox_id As String, ByVal checkbox_bin As String) As String
    Dim listofFormulaStrings As Range
    Set listofFormulaStrings = Range(FORMULASTRINGSLIST)
    
    Dim arraySize As Integer
    arraySize = Application.WorksheetFunction.CountIf(Range(TRUEFALSELIST), True)
    
    Dim textArray()
    ReDim textArray(arraySize)
    
    Dim arrayCounter As Integer
    arrayCounter = 1
    Dim x As Integer, y As Integer
    
    ' range(U17:V29)の空白でないセルの内容を配列にそのまま格納
    For x = 0 To 1 
        For y = 0 To TOTALNODE - 1
            If listofFormulaStrings.Offset(y, x).Value <> "" Then
                textArray(arrayCounter) = listofFormulaStrings.Offset(y, x).Value
                arrayCounter = arrayCounter + 1
            End If
        Next y
    Next x
    
    Dim temporaryOne As String
    temporaryOne = TABLENAME & "[" & checkbox_id & "]," & Chr(34) & checkbox_bin & Chr(34)
    
    Dim myExistence As Boolean
    myExistence = CheckMyExistenceInArray(textArray, arraySize, temporaryOne)
    
    Dim selectAll As String
    selectAll = ""
    
    If myExistence = True Then ' 自身を含む場合
        For x = 1 To arraySize
            If textArray(x) <> temporaryOne Then
                selectAll = selectAll & "," & textArray(x) ' 自身以外で文字列を作成
            End If
        Next
    Else ' 自身を含まない場合
        For x = 1 To arraySize
            selectAll = selectAll & "," & textArray(x) ' すべての配列で文字列を作成
        Next
    End If
    
    selectAll = selectAll & "," & temporaryOne ' 末尾に自身を強制的に加える
    GetTextStrings = selectAll
End Function

' ------------------------------------------------------------------------------
' 計算式の作成（自ノード含まず：分母部分）
' ------------------------------------------------------------------------------
Private Function GetTextStringswithoutMe(ByVal select_all As String, _
    ByVal checkbox_id As String, ByVal checkbox_bin As String) As String
    
    Dim selectAllwithoutMe As String
    selectAllwithoutMe = select_all
    
    Dim temporaryOne As String
    temporaryOne = "," & TABLENAME & "[" & checkbox_id & "]," & Chr(34) & checkbox_bin & Chr(34)

    GetTextStringswithoutMe = selectAllwithoutMe
End Function

' ------------------------------------------------------------------------------
' 配列内要素の存在チェック
' ------------------------------------------------------------------------------
Private Function CheckMyExistenceInArray(ByVal text_array, _
    ByVal array_size As Integer, ByVal temporary_one As String) As Boolean

    Dim i As Integer
    For i = 1 To array_size
        If text_array(i) = temporary_one Then
            CheckMyExistenceInArray = True
        End If
    Next
End Function


' ==============================================================================
' イベントハンドラ（各チェックボックスのクリック処理）
' ==============================================================================
Sub checkBoxAliceYes_Click(): CheckBoxID = 1: CheckBoxBIN = 1: Call ControllCheckBox(CheckBoxID, CheckBoxBIN): End Sub
Sub checkBoxAliceNo_Click(): CheckBoxID = 1: CheckBoxBIN = 2: Call ControllCheckBox(CheckBoxID, CheckBoxBIN): End Sub
Sub checkBoxAnnieYes_Click(): CheckBoxID = 2: CheckBoxBIN = 1: Call ControllCheckBox(CheckBoxID, CheckBoxBIN): End Sub
Sub checkBoxAnnieNo_Click(): CheckBoxID = 2: CheckBoxBIN = 2: Call ControllCheckBox(CheckBoxID, CheckBoxBIN): End Sub
Sub checkBoxJohannaYes_Click(): CheckBoxID = 3: CheckBoxBIN = 1: Call ControllCheckBox(CheckBoxID, CheckBoxBIN): End Sub
Sub checkBoxJohannaNo_Click(): CheckBoxID = 3: CheckBoxBIN = 2: Call ControllCheckBox(CheckBoxID, CheckBoxBIN): End Sub
Sub checkBoxNickieYes_Click(): CheckBoxID = 4: CheckBoxBIN = 1: Call ControllCheckBox(CheckBoxID, CheckBoxBIN): End Sub
Sub checkBoxNickieNo_Click(): CheckBoxID = 4: CheckBoxBIN = 2: Call ControllCheckBox(CheckBoxID, CheckBoxBIN): End Sub
Sub checkBoxHanaYes_Click(): CheckBoxID = 5: CheckBoxBIN = 1: Call ControllCheckBox(CheckBoxID, CheckBoxBIN): End Sub
Sub checkBoxHanaNo_Click(): CheckBoxID = 5: CheckBoxBIN = 2: Call ControllCheckBox(CheckBoxID, CheckBoxBIN): End Sub
Sub checkBoxBethYes_Click(): CheckBoxID = 6: CheckBoxBIN = 1: Call ControllCheckBox(CheckBoxID, CheckBoxBIN): End Sub
Sub checkBoxBethNo_Click(): CheckBoxID = 6: CheckBoxBIN = 2: Call ControllCheckBox(CheckBoxID, CheckBoxBIN): End Sub
Sub checkBoxSallyYes_Click(): CheckBoxID = 7: CheckBoxBIN = 1: Call ControllCheckBox(CheckBoxID, CheckBoxBIN): End Sub
Sub checkBoxSallyNo_Click(): CheckBoxID = 7: CheckBoxBIN = 2: Call ControllCheckBox(CheckBoxID, CheckBoxBIN): End Sub
Sub checkBoxLizYes_Click(): CheckBoxID = 8: CheckBoxBIN = 1: Call ControllCheckBox(CheckBoxID, CheckBoxBIN): End Sub
Sub checkBoxLizNo_Click(): CheckBoxID = 8: CheckBoxBIN = 2: Call ControllCheckBox(CheckBoxID, CheckBoxBIN): End Sub
Sub checkBoxTriciaYes_Click(): CheckBoxID = 9: CheckBoxBIN = 1: Call ControllCheckBox(CheckBoxID, CheckBoxBIN): End Sub
Sub checkBoxTriciaNo_Click(): CheckBoxID = 9: CheckBoxBIN = 2: Call ControllCheckBox(CheckBoxID, CheckBoxBIN): End Sub
Sub checkBoxSarahYes_Click(): CheckBoxID = 10: CheckBoxBIN = 1: Call ControllCheckBox(CheckBoxID, CheckBoxBIN): End Sub
Sub checkBoxSarahNo_Click(): CheckBoxID = 10: CheckBoxBIN = 2: Call ControllCheckBox(CheckBoxID, CheckBoxBIN): End Sub
Sub checkBoxClariceYes_Click(): CheckBoxID = 11: CheckBoxBIN = 1: Call ControllCheckBox(CheckBoxID, CheckBoxBIN): End Sub
Sub checkBoxClariceNo_Click(): CheckBoxID = 11: CheckBoxBIN = 2: Call ControllCheckBox(CheckBoxID, CheckBoxBIN): End Sub
Sub checkBoxEnidYes_Click(): CheckBoxID = 12: CheckBoxBIN = 1: Call ControllCheckBox(CheckBoxID, CheckBoxBIN): End Sub
Sub checkBoxEnidNo_Click(): CheckBoxID = 12: CheckBoxBIN = 2: Call ControllCheckBox(CheckBoxID, CheckBoxBIN): End Sub
Sub checkBoxLEADERYes_Click(): CheckBoxID = 13: CheckBoxBIN = 1: Call ControllCheckBox(CheckBoxID, CheckBoxBIN): End Sub
Sub checkBoxLEADERNo_Click(): CheckBoxID = 13: CheckBoxBIN = 2: Call ControllCheckBox(CheckBoxID, CheckBoxBIN): End Sub


' ==============================================================================
' メイン処理コントロール
' ==============================================================================

' ------------------------------------------------------------------------------
' チェックボックスの排他制御（YES/NOの同時選択防止）
' ------------------------------------------------------------------------------
Private Sub ControllCheckBox(ByVal checkbox_id As Integer, checkbox_bin As Integer)
    Dim partnerCheckboxBin As Integer
    If checkbox_bin = 1 Then
        partnerCheckboxBin = 2
    Else
        partnerCheckboxBin = 1
    End If
    
    Dim myownObjectName As String
    myownObjectName = "checkBox" & GetCheckBoxOwner(checkbox_id) & GetCheckBoxValue(checkbox_bin)
    
    Dim partnerObjectName As String
    partnerObjectName = "checkBox" & GetCheckBoxOwner(checkbox_id) & GetCheckBoxValue(partnerCheckboxBin)
    
    If ActiveSheet.CheckBoxes(myownObjectName).Value = xlOn And _
       ActiveSheet.CheckBoxes(partnerObjectName).Value = xlOn Then
        ActiveSheet.CheckBoxes(partnerObjectName).Value = xlOff
    End If

    Call SetFormula
End Sub

' ------------------------------------------------------------------------------
' 確率再計算とシートへの反映
' ------------------------------------------------------------------------------
Private Sub SetFormula()
    Dim formulaTail As String, formulaHeadYES As String, formulaHeadNO As String, myFormula As String
    Dim targetOne As Range
    Dim targetTwo As Range
    Set targetTwo = Range(TRUEFALSELIST).Range("A1").Offset(-1, -1)

    Dim x As Integer, y As Integer
    For y = 1 To TOTALNODE
        Set targetOne = Range(GetMarginsAddress(y))
        For x = 1 To 2
            Select Case x
                Case 1
                    formulaHeadYES = "=IF(AND(" & targetTwo.Offset(y, 1).Address & _
                        ",NOT(" & targetTwo.Offset(y, 2).Address & _
                        ")),1,IF(AND(NOT(" & targetTwo.Offset(y, 1).Address & ")," _
                        & targetTwo.Offset(y, 2).Address & "),0,"
                    myFormula = formulaHeadYES
                Case 2
                    formulaHeadNO = "=IF(AND(NOT(" & targetTwo.Offset(y, 1).Address & _
                        ")," & targetTwo.Offset(y, 2).Address & _
                        "),1,IF(AND(" & targetTwo.Offset(y, 1).Address & ",NOT(" _
                        & targetTwo.Offset(y, 2).Address & ")),0,"
                    myFormula = formulaHeadNO
            End Select
            
            Call ConvertTextToFormula(GetCheckBoxOwner(y), GetCheckBoxValue(x))
            
            formulaTail = Numerator & " / " & Denominator
            myFormula = myFormula & formulaTail & "))"
            targetOne.Offset(x - 1, 0).Formula = myFormula
            
            ' 変数のリセット
            formulaHeadYES = "": formulaHeadNO = "": formulaTail = "": myFormula = ""
        Next x
    Next y
    Numerator = "": Denominator = ""
End Sub

' ------------------------------------------------------------------------------
' 集計関数（SUMIFS）の組み立て
' ------------------------------------------------------------------------------
Private Sub ConvertTextToFormula(ByVal checkbox_id As String, ByVal checkbox_bin As String)
    Dim temporaryNumerator As String
    temporaryNumerator = "SUMIFS(" & TABLENAME & "[" & HEADWORDOFSUBTOTAL & "]" & _
        GetTextStrings(checkbox_id, checkbox_bin) & ")"
        
    Dim temporaryDenominator As String
    temporaryDenominator = "SUMIFS(" & TABLENAME & "[" & HEADWORDOFSUBTOTAL & "]" & _
        GetTextStringswithoutMe(GetTextStrings(checkbox_id, checkbox_bin), checkbox_id, checkbox_bin) & ")"
        
    If temporaryDenominator = "SUMIFS(" & TABLENAME & "[" & HEADWORDOFSUBTOTAL & "])" Then
        temporaryDenominator = "SUM(" & TABLENAME & "[" & HEADWORDOFSUBTOTAL & "])"
    End If

    Numerator = temporaryNumerator
    Denominator = temporaryDenominator
End Sub

マクロをすべてのチェックボックスコントロールに割り当てます。たとえばALICEのYESには、checkBoxAliceYesを割り当てます。これをコントロールの数だけ繰り返します。

各チェックボックスコントロールに対応するマクロを割り当て

ベイジアンネットワークの完成です。任意のチェックをはじめて動作させたタイミングで、確率が再計算されます。

ベイジアンネットワーク Excel 完成

たとえば第1層・第2層の4人にそれぞれ観測した値を置く（=チェックを入れる）と、第3層のそれぞれのメンバーの確率は次のように示されます。チェックのON・OFFのみであれこれシミュレーションが可能です。

第1層・第2層にエビデンスを付けた時の第3層メンバーの確率変動

晴花