ノードとエッジを使って，「つながり」「ながれ」「かかわり」といった関係を描写する 2/3

有向グラフの場合

イントロダクション

Step 0シチュエーションの設定

説明上の必要から，「1.無向グラフの場合」で作成した関係性のグラフをイメージとして引用します(下図)。ここではこの組織に，あるあたらしいワークが発生したとして話をすすめます。

さて，このワークでは，成果物を各部門のリーダーが査収します。したがって，先の無向グラフに方向性を組み入れるとしたなら，エッジは次のような突端を持ちえます。

さらにはこのワークは，従来のようにリーダー間で調整をなすのではなく，専任の管理者をおいてすすめられることになりました。

管理者「Iris」は，成果物の査収に加え各部のリーダーとの間で諸事の調整を図ります。これを示すに，「Iris」へのエッジには，その両端に矢を加えるものとします。

ここでは，以上のような関係性を図示していきます。

基本的な流れは前頁と同様です。したがってRパッケージのインストールなど作業に従となる要素についての言及は省きます。

さて，ここで目的とする表現は，下図円形ノードからなるシンプルなグラフと，

下図ピクチャノードによるグラフの2点です。

illustration: "Girl's Design Materials"

仕様

自己ループおよび同じ方向の多重エッジには非対応です

作図にあたり参考にした書籍およびWebページ(「１.無向グラフの場合」と同じ)

杉山公造(1993)『グラフ自動描画法とその応用 ―ビジュアルヒューマンインタフェース―』計測自動制御学会編, コロナ社, pp.8-16., 77-81.
R+igraph ―"Kazuhiro Takemoto"(2017.1閲覧)
igraphパッケージの使い方 1.グラフオブジェクトの作成と取り扱い, igraphパッケージの使い方 2.グラフオブジェクトのプロット ―"もうカツ丼でいいよな"(2017.1閲覧)
グラフ・ネットワーク分析で遊ぶ(1)：グラフ可視化・描画手法 ―"六本木で働くデータサイエンティストのブログ"(2017.1閲覧)
隣接行列 ―"WTOPIA v1.0 documentation"(2017.1閲覧)

工程｜前段

Step 1［隣接行列シート］ノードの配置

ワークの“ながれ”を行列によってあらわします。ここでは，このためのシートを「隣接行列」と名付けます。

「隣接行列」シートの縦方向ないしは横方向にすべてのノードを書き出して，それらを残る一方に対し「行列を入れ替える」でコピーします。

scrollable

Step 2［隣接行列シート］“ながれ”の書き出し(1)

各ノードに関し，行方向に“ながれ”の起(始)点を示していきます。

たとえばここでの例の場合，Step 0の設定では，ノード「Iris」は各部門のリーダー3人とエッジを持っていることがわかります。したがって，「Iris」行に関しては，列見出しの該当するノードとの交点にそれぞれ「1」を立てていきます。

scrollable

残るメンバーに関しても同様の作業をおこないます。注意点として，たとえば次行「Sarah」の場合，Step 0の設定では，周囲に5本のエッジが存在しているのがわかります。有向グラフの場合，問題とするのはあくまで起点だけ(＝「Sarah」から始まるエッジか)なので，「Sarah」行に立てるtrue(1)は「Iris」列との交点のみとなります。

そんな感じでこれらを処理したものが下図です。

scrollable

Step 3［隣接行列シート］“ながれ”の書き出し(2)

この行列の中の未入力の場所，換言すれば起点のエッジを持たないものを明示します。

最初にこの行列以外の，たとえばシートの外れにでも「0」と入力し，これをコピーします。

次に行列の見出しを除くすべての部分を選択し

「形式を選択して貼り付け」から

演算「加算」の貼り付けを選びます。

これにより，「1」以外の空のセルが「0」で埋まります。この時点で，一時的に利用する目的で入力した先の0を削除しておきます。

scrollable

Step 4［座標シート］見出しの作成(1)

あたらしい別のシートに，グラフ描画に必要なデータを用意していきます。ここではこのシートを，便宜上「座標」シートと呼ぶことにします。

さしずめ，以下の場所にそれぞれ見出しを入力しておきます。

ピクチャノードを利用する場合は，セルB1に，素材を格納してあるフォルダまでのフルパスを入力しておき(したがってすべての素材が同じフォルダの中に準備されている必要があります)

「隣接行列」シートから，縦に並べたすべてのノード(行見出し)をコピーして，この「座標」シートに貼り付けます。

ピクチャノードを利用する場合には，「File」欄に，各ノードに対応するファイルの名前をそれぞれ指定しておきます。

工程｜中段

Step 5［R］igraphパッケージの読み込み

Rを起動します。

ここでは別途「igraph」パッケージを必要とします。これがRにインストールされていない場合，インストールを要します。とまれ

library(igraph)

にてパッケージを呼び出します。

scrollable

Step 6［R］ノード座標の計算

Excelに戻り「隣接行列」シートの行列を見出しも含めて選択し，クリップボードにコピーしておきます。

再びRに移って，コンソールに

dat <- as.matrix(read.table("clipboard", header=T, row.names=1))

と入力します。これにより，オブジェクトdatにクリップボードの内容を見出し付きの行列として保持させます。

scrollable

続けて

g <- graph.adjacency(dat, mode="directed")

と入力します。これにより，datを“方向性を持つ”エッジリストに転換し，この結果をオブジェクトgに保持させます。

scrollable

このgの内容がExcelで利用したいもののうちの1つですので，これをテキストファイルに書き出します。

ここではテキストファイルを作業ディレクトリにそのまま書き出します。したがってファイル名(edgelist.txt)のみしか記していませんが，任意の場所に出力したい場合，その場所までをフルパスで明示する必要があります。

write_graph(g, "edgelist.txt", "ncol")

scrollable

gをもとに，任意のアルゴリズムを使ってノードの座標を求めます。結果はオブジェクトlayに渡します。

さて，そのアルゴリズムですが，ここではKamada-Kawai layout algorithmを使用するものとします。

lay <- layout_with_kk(g)

※他のアルゴリズムについては，「1.無向グラフの場合」を参照。

scrollable

このlayの内容がExcelで利用したいものの残る1つですので，これをテキストファイルに書き出します。

ここでも同様，テキストファイルを作業ディレクトリに書き出すのでファイル名(node.txt)のみしか記していません。任意の場所に出力したい場合，その場所までフルパスで明示することが必要です。

write.table(lay, file="node.txt", row.names=F, col.names=F)

scrollable

Step 7［座標シート］計算結果をExcelへ

先のStepで作成したnode.txtを開きます。

このファイルの内容をすべて選択し，クリップボードにコピーします。

「座標」シートのセルB4をアクティブにして，貼り付けテキストファイルウィザードを使用，とたどります。

ダイアログの「元のデータ形式」が「カンマやタブなど」側が選択されていることを確認して，完了を返します。

同様の作業をedgelist.txtにおいても繰り返し，セルF4にデータを貼り付けます。

scrollable

このとき，G列の内容を行位置を保ったままI列に移します。

scrollable

F列とI列のノード名の間を，マイナス記号(-)で埋めておきます。

scrollable

工程｜後段

Step 8［座標シート］散布図で“ながれ”を描く

これまでに求めた座標にいくらかの調整を加え，それらを使って目的のグラフを描きます。

これは手間を必要とするので，ここではマクロで処理します。上述のシート構成の場合のみ，下のコードが機能します。

Const ratio As Double = 0.1 ' 重み

Sub DrawDirectedGraph()
' "ながれ" 描写のための有向グラフ ver.17.0129
' *** bdastyle.net/tools/scatterplot/network-visualization-based-on-force-directed-layout-2.html
' *** by hawcas 2017

Dim tgtNode As Range ' Nodeのデータ範囲
Dim tgtEdge As Range ' Edgeのデータ範囲

Dim n As Long ' リストの数-1
Dim capSP() As String ' 始点ノード
Dim capEP() As String ' 終点ノード
Dim naEG() As Boolean ' 非描画エッジ@双方向
Dim apEG() As Boolean ' 描画エッジ@双方向
Dim cntUD As Long ' 無向エッジのカウンタ
Dim myFormula(14) As String ' 計算式
Dim serNo As Integer ' 系列番号
Dim serName As String ' 系列名
Dim myDir As String ' 画像ディレクトリ
Dim adLabel As String ' ラベルのアドレス

Dim myStr As String
Dim i As Long
Dim j As Long
Dim k As Long

Application.ScreenUpdating = False

' シートをコピー
myStr = ActiveSheet.Name
ActiveSheet.Copy after:=Worksheets(myStr)

' ノードに関するセル範囲を格納
Set tgtNode = Range("a3").CurrentRegion
Set tgtNode = tgtNode.Range("a2").Resize(RowSize:=tgtNode.Rows.Count - 1, columnsize:=4)

' エッジに関するセル範囲を格納
Set tgtEdge = Range("f3").CurrentRegion
Set tgtEdge = tgtEdge.Range("a2").Resize(RowSize:=tgtEdge.Rows.Count - 1, columnsize:=8)

Call Heading ' 見出しを作成

' エッジの始点/終点のノード名を格納
n = tgtEdge.Rows.Count - 1
ReDim capSP(n)
ReDim capEP(n)
ReDim naEG(n)
ReDim apEG(n)
For i = 0 To n
    capSP(i) = Range("f4").Offset(i, 0).Value
    capEP(i) = Range("f4").Offset(i, 3).Value
Next

' エッジリストを書き換える
cntUD = 0
k = 0
For i = 0 To n ' 終点ノード
    For j = k To n ' 始点ノード
        If capSP(j) = capEP(i) Then
            If capSP(i) = capEP(j) Then
                apEG(i) = True ' 描画
                naEG(j) = True ' 非描画
                cntUD = cntUD + 1
                Exit For
            End If
        End If
    Next
    k = k + 1
Next

j = 0
For i = 0 To n
    If naEG(i) = False Then
        With Range("f4")
            .Offset(j, 0).Value = capSP(i)
            .Offset(j, 2).Value = ">"
            .Offset(j, 3).Value = capEP(i)
            If apEG(i) = True Then ' 双方向の場合
                .Offset(j, 1).Value = "<"
            End If
        End With
        j = j + 1
    End If
Next

If Not (cntUD = 0) Then ' 余剰が出た場合それを削除
    Range(Range("f4").Offset(n + 1 - cntUD, 0), Range("f4").Offset(n, 3)).Delete
End If

' tgtEdge の修正
Set tgtEdge = tgtEdge.Range("a1").Resize(RowSize:=n + 1 - cntUD, columnsize:=19)

' 計算式を作ってシートに配置
n = tgtEdge.Rows.Count - 1
For i = 0 To n
    myFormula(0) = ex1(tgtEdge, tgtNode, i)
    myFormula(1) = ex2(tgtEdge, tgtNode, i)
    myFormula(2) = ey1(tgtEdge, tgtNode, i)
    myFormula(3) = ey2(tgtEdge, tgtNode, i)
    myFormula(4) = hypotenuse(tgtEdge, i)
    myFormula(5) = flgx(tgtEdge, i)
    myFormula(6) = flgy(tgtEdge, i)
    myFormula(7) = direction(tgtEdge, i)
    myFormula(8) = rad(tgtEdge, i)

    k = 0
    For j = 4 To 12
        tgtEdge.Range("a1").Offset(i, j).Formula = myFormula(k)
        k = k + 1
    Next
Next

    Range("n1").Formula = "=average(" & Range(tgtEdge.Range("a1").Offset(0, 8), _
        tgtEdge.Range("a1").Offset(n, 8)).Address & ")*" & ratio ' marginを設置

For i = 0 To n
    myFormula(9) = mbase(tgtEdge, i)
    myFormula(10) = mheight(tgtEdge, i)
    myFormula(11) = ex1prime(tgtEdge, i)
    myFormula(12) = ex2prime(tgtEdge, i)
    myFormula(13) = ey1prime(tgtEdge, i)
    myFormula(14) = ey2prime(tgtEdge, i)

    k = 9
    For j = 13 To 18
        tgtEdge.Range("a1").Offset(i, j).Formula = myFormula(k)
        k = k + 1
    Next
Next

' 散布図を挿入
Range(tgtNode.Range("b1"), tgtNode.Range("b1").Offset(tgtNode.Rows.Count - 1, 1)).Select
ActiveSheet.Shapes.AddChart(xlXYScatter).Select

' ノード系列の基本的な書式設定
serNo = 1
With ActiveChart
    .HasLegend = False
    With .SeriesCollection(serNo)
        .Name = "Node"
        .MarkerStyle = xlMarkerStyleCircle
        .MarkerForegroundColorIndex = xlColorIndexNone ' 枠線なし
        .MarkerBackgroundColor = RGB(80, 80, 80) ' マーカーの色
    End With
End With

' エッジ系列の挿入
For i = 0 To tgtEdge.Rows.Count - 1
    serName = ""
    For j = 0 To 3
        serName = serName & tgtEdge.Range("a1").Offset(i, j)
    Next
    With ActiveChart.SeriesCollection.NewSeries
        .XValues = Range(tgtEdge.Range("a1").Offset(i, 15), tgtEdge.Range("a1").Offset(i, 16))
        .Values = Range(tgtEdge.Range("a1").Offset(i, 17), tgtEdge.Range("a1").Offset(i, 18))
        .Name = serName
        .Border.Color = RGB(168, 0, 0) ' 線色
        .Format.Line.Weight = 1.5 'pt, 線幅
    End With
Next

' エッジを直線に
For serNo = 2 To tgtEdge.Rows.Count + 1
    With ActiveChart.SeriesCollection(serNo)
        .ChartType = xlXYScatterLinesNoMarkers ' 散布図→直線
        .Format.Line.EndArrowheadStyle = msoArrowheadOpen ' 終点:開いた矢印
        If apEG(serNo - 2) = True Then
            .Format.Line.BeginArrowheadStyle = msoArrowheadOpen ' 始点:開いた矢印
        End If
    End With
Next

' ピクチャノードか否か
For i = 0 To tgtNode.Rows.Count - 1
    Select Case tgtNode.Range("d1").Offset(i, 0).Value
    Case "" ' File未指定の場合→円形ノード
        With ActiveSheet.ChartObjects(1).Chart.SeriesCollection(1).Points(i + 1)
            .MarkerSize = 14 ' pt, マーカーサイズ
        End With
    Case Else ' File指定の場合→ピクチャノード
        myDir = Range("b1").Value & "\" & tgtNode.Range("d1").Offset(i, 0).Value
        With ActiveSheet.ChartObjects(1).Chart.SeriesCollection(1).Points(i + 1)
            '.MarkerStyle = xlMarkerStylePicture ' 「塗り色」としてではなくピクチャそのものを指定する場合
            .MarkerSize = 36 ' pt, マーカーサイズ ' 「塗り色」としてではなくピクチャそのものを指定する場合,ここはコメントアウト
            .Fill.UserPicture (myDir)
        End With
    End Select
Next

' データラベルを挿入
adLabel = "'" & ActiveSheet.Name & "'!" & _
    Range(tgtNode.Range("a1"), tgtNode.Range("a1").Offset(tgtNode.Rows.Count - 1, 0)).Address
With ActiveSheet.ChartObjects(1).Chart.SeriesCollection(1)
    .HasDataLabels = True
    With .DataLabels
        .Format.TextFrame2.TextRange.InsertChartField msoChartFieldRange, (adLabel), 0
        .ShowRange = True
        .ShowValue = False
        .Position = xlLabelPositionBelow
    End With
End With

Application.ScreenUpdating = True

End Sub

Private Sub Heading()

Dim myList As Variant
Dim i As Integer

    myList = Array( _
        "ex1", "ex2", "ey1", "ey2", _
        "hypotenuse", _
        "flg-x", "flg-y", "direction", _
        "rad", "m-base", "m-height", _
        "ex1'", "ex2'", "ey1'", "ey2'" _
        )
    
    For i = 0 To 14
        Range("j3").Offset(0, i).Value = myList(i)
    Next
    
    Range("m1").Value = "margin"
    
End Sub

Private Function ex1(myErange As Range, myNrange As Range, myRow As Long) As String

    ex1 = "=vlookup(" & myErange.Range("a1").Offset(myRow, 0). _
        Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
            ", " & myNrange.Address & ", 2, false)" ' ex1(J)

End Function
Private Function ex2(myErange As Range, myNrange As Range, myRow As Long) As String

    ex2 = "=vlookup(" & myErange.Range("a1").Offset(myRow, 3). _
        Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
            ", " & myNrange.Address & ", 2, false)" ' ex2(K)

End Function
Private Function ey1(myErange As Range, myNrange As Range, myRow As Long) As String

    ey1 = "=vlookup(" & myErange.Range("a1").Offset(myRow, 0). _
        Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
            ", " & myNrange.Address & ", 3, false)" ' ey1(L)

End Function
Private Function ey2(myErange As Range, myNrange As Range, myRow As Long) As String

    ey2 = "=vlookup(" & myErange.Range("a1").Offset(myRow, 3). _
        Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
            ", " & myNrange.Address & ", 3, false)" ' ey2(M)

End Function
Private Function hypotenuse(myErange As Range, myRow As Long) As String

Dim obj As Range
Set obj = myErange.Range("a1")

    hypotenuse = "=sqrt((" & obj.Offset(myRow, 5). _
        Address(RowAbsolute:=False, ColumnAbsolute:=False) & "-" & _
        obj.Offset(myRow, 4). _
        Address(RowAbsolute:=False, ColumnAbsolute:=False) & ")^2+(" & _
        obj.Offset(myRow, 7). _
        Address(RowAbsolute:=False, ColumnAbsolute:=False) & "-" & _
        obj.Offset(myRow, 6). _
        Address(RowAbsolute:=False, ColumnAbsolute:=False) & ")^2)" ' hypotenuse(N)

End Function
Private Function flgx(myErange As Range, myRow As Long) As String

Dim obj As Range
Set obj = myErange.Range("a1")

    flgx = "=if((" & obj.Offset(myRow, 5). _
        Address(RowAbsolute:=False, ColumnAbsolute:=False) & "-" & _
        obj.Offset(myRow, 4). _
        Address(RowAbsolute:=False, ColumnAbsolute:=False) & ")>0, 1, if((" & _
        obj.Offset(myRow, 5). _
        Address(RowAbsolute:=False, ColumnAbsolute:=False) & "-" & _
        obj.Offset(myRow, 4). _
        Address(RowAbsolute:=False, ColumnAbsolute:=False) & ")<0, -1, 0))" ' flg-x(O)

End Function
Private Function flgy(myErange As Range, myRow As Long) As String

Dim obj As Range
Set obj = myErange.Range("a1")

    flgy = "=if((" & obj.Offset(myRow, 7). _
        Address(RowAbsolute:=False, ColumnAbsolute:=False) & "-" & _
        obj.Offset(myRow, 6). _
        Address(RowAbsolute:=False, ColumnAbsolute:=False) & ")>0, 1, if((" & _
        obj.Offset(myRow, 7). _
        Address(RowAbsolute:=False, ColumnAbsolute:=False) & "-" & _
        obj.Offset(myRow, 6). _
        Address(RowAbsolute:=False, ColumnAbsolute:=False) & ")<0, -1, 0))" ' flg-y(P)

End Function
Private Function direction(myErange As Range, myRow As Long) As String

Dim obj As Range
Set obj = myErange.Range("a1")

    direction = "=if(and(" & obj.Offset(myRow, 9).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "=1, " & obj.Offset(myRow, 10).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "=0), 1, if(and(" & obj.Offset(myRow, 9).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "=0, " & obj.Offset(myRow, 10).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "=1), 2, if(and(" & obj.Offset(myRow, 9).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "=-1, " & obj.Offset(myRow, 10).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "=0), 3, if(and(" & obj.Offset(myRow, 9).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "=0, " & obj.Offset(myRow, 10).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "=-1), 4, if(and(" & obj.Offset(myRow, 9).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "=1, " & obj.Offset(myRow, 10).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "=1), 5, if(and(" & obj.Offset(myRow, 9).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "=-1, " & obj.Offset(myRow, 10).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "=1), 6, if(and(" & obj.Offset(myRow, 9).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "=-1, " & obj.Offset(myRow, 10).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "=-1), 7, if(and(" & obj.Offset(myRow, 9).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "=1, " & obj.Offset(myRow, 10).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "=-1), 8, 9))))))))" ' direction(Q)

End Function
Private Function rad(myErange As Range, myRow As Long) As String

Dim obj As Range
Set obj = myErange.Range("a1")

    rad = "=if((" & obj.Offset(myRow, 5).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "-" & obj.Offset(myRow, 4).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        ")=0, 0, abs(atan((" & obj.Offset(myRow, 7).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "-" & obj.Offset(myRow, 6).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        ")/(" & obj.Offset(myRow, 5).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "-" & obj.Offset(myRow, 4).Address(RowAbsolute:=False, ColumnAbsolute:=False) & "))))" ' rad(R)

End Function
Private Function mbase(myErange As Range, myRow As Long) As String

Dim obj As Range
Set obj = myErange.Range("a1")

    mbase = "=if(or(" & obj.Offset(myRow, 11).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "=1, " & obj.Offset(myRow, 11).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "=3, " & obj.Offset(myRow, 11).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "=5, " & obj.Offset(myRow, 11).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "=6, " & obj.Offset(myRow, 11).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "=7, " & obj.Offset(myRow, 11).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "=8), " & Range("n1").Address & "*cos(" & obj.Offset(myRow, 12). _
        Address(RowAbsolute:=False, ColumnAbsolute:=False) & "), 0)" ' m-base(S)

End Function
Private Function mheight(myErange As Range, myRow As Long) As String

Dim obj As Range
Set obj = myErange.Range("a1")

    mheight = "=if(or(" & obj.Offset(myRow, 11).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "=5, " & obj.Offset(myRow, 11).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "=6, " & obj.Offset(myRow, 11).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "=7, " & obj.Offset(myRow, 11).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "=8), " & Range("n1").Address & "*sin(" & obj.Offset(myRow, 12). _
        Address(RowAbsolute:=False, ColumnAbsolute:=False) & "), " & Range("n1").Address & ")" ' m-height(T)

End Function
Private Function ex1prime(myErange As Range, myRow As Long) As String

Dim obj As Range
Set obj = myErange.Range("a1")

    ex1prime = "=if(" & obj.Offset(myRow, 1).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "=""<"", if(or(" & obj.Offset(myRow, 11).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "=1, " & obj.Offset(myRow, 11).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "=5, " & obj.Offset(myRow, 11).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "=8), " & obj.Offset(myRow, 4).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "+" & obj.Offset(myRow, 13).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        ", if(or(" & obj.Offset(myRow, 11).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "=3, " & obj.Offset(myRow, 11).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "=6, " & obj.Offset(myRow, 11).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "=7), " & obj.Offset(myRow, 4).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "-" & obj.Offset(myRow, 13).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        ", if(or(" & obj.Offset(myRow, 11).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "=2, " & obj.Offset(myRow, 11).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "=4), " & obj.Offset(myRow, 5).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        ", if(" & obj.Offset(myRow, 11).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "=9," & obj.Offset(myRow, 4).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        ")))), " & obj.Offset(myRow, 4).Address(RowAbsolute:=False, ColumnAbsolute:=False) & ")" ' ex1'(U)

End Function
Private Function ex2prime(myErange As Range, myRow As Long) As String

Dim obj As Range
Set obj = myErange.Range("a1")

    ex2prime = "=if(or(" & obj.Offset(myRow, 11).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "=1, " & obj.Offset(myRow, 11).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "=5, " & obj.Offset(myRow, 11).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "=8), " & obj.Offset(myRow, 5).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "-" & obj.Offset(myRow, 13).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        ", if(or(" & obj.Offset(myRow, 11).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "=3, " & obj.Offset(myRow, 11).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "=6, " & obj.Offset(myRow, 11).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "=7), " & obj.Offset(myRow, 5).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "+" & obj.Offset(myRow, 13).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        ", if(or(" & obj.Offset(myRow, 11).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "=2, " & obj.Offset(myRow, 11).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "=4), " & obj.Offset(myRow, 5).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        ", if(" & obj.Offset(myRow, 11).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "=9," & obj.Offset(myRow, 4).Address(RowAbsolute:=False, ColumnAbsolute:=False) & "))))" ' ex2'(V)

End Function
Private Function ey1prime(myErange As Range, myRow As Long) As String

Dim obj As Range
Set obj = myErange.Range("a1")

    ey1prime = "=if(" & obj.Offset(myRow, 1).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "=""<"", if(or(" & obj.Offset(myRow, 11).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "=2, " & obj.Offset(myRow, 11).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "=5, " & obj.Offset(myRow, 11).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "=6), " & obj.Offset(myRow, 6).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "+" & obj.Offset(myRow, 14).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        ", if(or(" & obj.Offset(myRow, 11).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "=4, " & obj.Offset(myRow, 11).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "=7, " & obj.Offset(myRow, 11).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "=8), " & obj.Offset(myRow, 6).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "-" & obj.Offset(myRow, 14).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        ", if(or(" & obj.Offset(myRow, 11).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "=1, " & obj.Offset(myRow, 11).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "=3), " & obj.Offset(myRow, 6).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        ", if(" & obj.Offset(myRow, 11).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "=9," & obj.Offset(myRow, 6).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        ")))), " & obj.Offset(myRow, 6).Address(RowAbsolute:=False, ColumnAbsolute:=False) & ")" ' ey1'(W)

End Function
Private Function ey2prime(myErange As Range, myRow As Long) As String

Dim obj As Range
Set obj = myErange.Range("a1")

    ey2prime = "=if(or(" & obj.Offset(myRow, 11).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "=2, " & obj.Offset(myRow, 11).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "=5, " & obj.Offset(myRow, 11).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "=6), " & obj.Offset(myRow, 7).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "-" & obj.Offset(myRow, 14).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        ", if(or(" & obj.Offset(myRow, 11).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "=4, " & obj.Offset(myRow, 11).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "=7, " & obj.Offset(myRow, 11).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "=8), " & obj.Offset(myRow, 7).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "+" & obj.Offset(myRow, 14).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        ", if(or(" & obj.Offset(myRow, 11).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "=1, " & obj.Offset(myRow, 11).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "=3), " & obj.Offset(myRow, 7).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        ", if(" & obj.Offset(myRow, 11).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "=9," & obj.Offset(myRow, 6).Address(RowAbsolute:=False, ColumnAbsolute:=False) & "))))" ' ey2'(X)

End Function

Step 9グラフの完成

マクロによって，円形のノードの場合は下図のような，

ピクチャノードの場合は下図のようなアウトプットが導けます。

下では無向グラフのように見えますが，これはピクチャノードの場合，初期の設定値ではエッジの突端がノードによって遮蔽されるゆえ，です。

エッジの長さは，表上部の「margin」にて任意に調整できます。0< margin <1の範囲(双方向が混在する場合，上限はこの半分程度)で，値が大きなほど短くなります。

先のようにエッジの突端が隠れた場合など，これによって調整が可能です。

scrollable

縦横軸の表示範囲を調整する，あるいはデータラベルに書式設定を加えるなどして任意の加工を続け，目的のグラフの完成です。

次は多重エッジを分割し，人物の相関図を描画します。

その他の参照

このサイトの関連How-toです。

Home

BDAstyle

Business Data Analysis & Visualization with Excel

ノードとエッジを使って，「つながり」「ながれ」「かかわり」といった関係を描写する 2/3

有向グラフの場合

イントロダクション

Step 0シチュエーションの設定

仕様

作図にあたり参考にした書籍およびWebページ(「１.無向グラフの場合」と同じ)

工程｜前段

Step 1［隣接行列シート］ノードの配置

Step 2［隣接行列シート］“ながれ”の書き出し(1)

Step 3［隣接行列シート］“ながれ”の書き出し(2)

Step 4［座標シート］見出しの作成(1)

工程｜中段

Step 5［R］igraphパッケージの読み込み

Step 6［R］ノード座標の計算

Step 7［座標シート］計算結果をExcelへ

工程｜後段

Step 8［座標シート］散布図で“ながれ”を描く

Step 9グラフの完成

Next

その他の参照