BDAstyle

Business Data Analysis & Visualization with Excel

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

有向グラフで「人物相関図」を作成する

イントロダクション

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

説明上の必要から，「2.有向グラフの場合」で作成した関係性のグラフをイメージとして引用します(下図)。

さて，この図は個々のノードを起点とする矢印のついたエッジを持っているので，それにコメントをつけるなりすれば，個々の人物の“かかわり”を示すグラフすなわち「人物相関図」に一見簡単に転用できそうな気もします。

ですがいざそれをおこなわんとすると，実際には図のハイライトの箇所への対処で頭を悩ませることとなります。

双方向のかかわりを上図のように1本のエッジで示すことは，見た目にはスッキリして良好だとは思いますが，今回のようにエッジを完全に識別したい・する必要がある場合に限っては，翻って不都合を生む要素ともなりえます。

要するに，人物相関図などで個々のかかわりの表現においてエッジを占有したい場合，選択肢としてエッジを分かつことができるならば好都合です。これはたとえば下図のように，エッジに何らの感情アイコン・進捗アイコンといったものを加えたり，

また下図のようにコメントを打ったりといった施策が可能となることを意味します。

そこでここでは，双方向のエッジを方向の別に分離させるタイプのグラフの作成を，これまでと同様ExcelとRによってすすめていこうと思います。

以下，その手続きです。

illustration: "Girl's Design Materials"

仕様

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

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


工程｜前段

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

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

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

scrollable

Step 2［隣接行列シート］“かかわり”の書き出し(1)

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

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

scrollable

残るメンバーに関しても同様の作業をおこないます。注意点として，たとえば次行「Sarah」の場合，Step 0の設定では，周囲に6本のエッジが存在しているのがわかります。有向グラフの場合，問題とするのはあくまで起点だけ(＝「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()
' "かかわり" 描写のための有向グラフ(双方向を2本のエッジであらわすもの) ver.17.0129
' *** bdastyle.net/tools/scatterplot/network-visualization-based-on-force-directed-layout-3.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 myFormula(18) 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

' 双方向のフラグ立て
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 ' 非描画
                Exit For
            End If
        End If
    Next
    k = k + 1
    Range("f4").Offset(i, 2).Value = ">"
    If apEG(i) = True Or naEG(i) = True Then
        Range("f4").Offset(i, 1).Value = "<"
    End If
Next

' 計算式を作ってシートに配置
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を設置
    Range("Q1").Formula = "=" & Range("n1").Address & "*0.4" ' gapを設置

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

' 双方向の場合，2本のエッジに座標をわける
For i = 0 To n
    If apEG(i) = True Then
        myFormula(15) = ex1primeL(tgtEdge, i)
        myFormula(16) = ex2primeL(tgtEdge, i)
        myFormula(17) = ey1primeL(tgtEdge, i)
        myFormula(18) = ey2primeL(tgtEdge, i)
    End If
    If naEG(i) = True Then
        myFormula(15) = ex1primeR(tgtEdge, i)
        myFormula(16) = ex2primeR(tgtEdge, i)
        myFormula(17) = ey1primeR(tgtEdge, i)
        myFormula(18) = ey2primeR(tgtEdge, i)
    End If
    
    k = 15
    For j = 19 To 22
        If apEG(i) = True Or naEG(i) = True Then
            tgtEdge.Range("a1").Offset(i, j).Formula = myFormula(k)
            k = k + 1
        End If
    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
        If apEG(i) = False And naEG(i) = False Then ' 一方向
            .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))
        Else ' 双方向
            .XValues = Range(tgtEdge.Range("a1").Offset(i, 19), tgtEdge.Range("a1").Offset(i, 20))
            .Values = Range(tgtEdge.Range("a1").Offset(i, 21), tgtEdge.Range("a1").Offset(i, 22))
        End If
        .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 ' 終点:開いた矢印
    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'", _
        "ex1''", "ex2''", "ey1''", "ey2''" _
        )
    
    For i = 0 To 18
        Range("j3").Offset(0, i).Value = myList(i)
    Next
    
    Range("m1").Value = "margin"
    Range("p1").Value = "gap"
    
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
Private Function ex1primeL(myErange As Range, myRow As Long) As String

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

    ex1primeL = "=if(or(" & obj.Offset(myRow, 11).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "=1, " & obj.Offset(myRow, 11).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "=6, " & obj.Offset(myRow, 11).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "=8), " & obj.Offset(myRow, 15).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "-(" & Range("q1").Address & "*cos((2*pi()/4)-" & _
        obj.Offset(myRow, 12).Address(RowAbsolute:=False, ColumnAbsolute:=True) & _
        ")), if(or(" & 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) & _
        "=7), " & obj.Offset(myRow, 15).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "-(" & Range("q1").Address & "*sin(" & _
        obj.Offset(myRow, 12).Address(RowAbsolute:=False, ColumnAbsolute:=True) & _
        ")), " & obj.Offset(myRow, 15).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "-" & Range("q1").Address & "))" ' ex1'(U')

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

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

    ex2primeL = "=if(or(" & obj.Offset(myRow, 11).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "=1, " & obj.Offset(myRow, 11).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "=6, " & obj.Offset(myRow, 11).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "=8), " & obj.Offset(myRow, 16).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "-(" & Range("q1").Address & "*cos((2*pi()/4)-" & _
        obj.Offset(myRow, 12).Address(RowAbsolute:=False, ColumnAbsolute:=True) & _
        ")), if(or(" & 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) & _
        "=7), " & obj.Offset(myRow, 16).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "-(" & Range("q1").Address & "*sin(" & _
        obj.Offset(myRow, 12).Address(RowAbsolute:=False, ColumnAbsolute:=True) & _
        ")), " & obj.Offset(myRow, 16).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "-" & Range("q1").Address & "))" ' ex2'(V')

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

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

    ey1primeL = "=if(or(" & obj.Offset(myRow, 11).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "=6, " & obj.Offset(myRow, 11).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "=8), " & obj.Offset(myRow, 17).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "-(" & Range("q1").Address & "*sin((2*pi()/4)-" & _
        obj.Offset(myRow, 12).Address(RowAbsolute:=False, ColumnAbsolute:=True) & _
        ")), if(or(" & obj.Offset(myRow, 11).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "=5, " & obj.Offset(myRow, 11).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "=7), " & obj.Offset(myRow, 17).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "+(" & Range("q1").Address & _
        "*cos(" & obj.Offset(myRow, 12).Address(RowAbsolute:=False, ColumnAbsolute:=True) & _
        ")), 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, 17).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "+" & Range("q1").Address & ", " & _
        obj.Offset(myRow, 17).Address(RowAbsolute:=False, ColumnAbsolute:=False) & ")))" ' ey1'(W')

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

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

    ey2primeL = "=if(or(" & obj.Offset(myRow, 11).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "=6, " & obj.Offset(myRow, 11).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "=8), " & obj.Offset(myRow, 18).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "-(" & Range("q1").Address & "*sin((2*pi()/4)-" & _
        obj.Offset(myRow, 12).Address(RowAbsolute:=False, ColumnAbsolute:=True) & _
        ")), if(or(" & obj.Offset(myRow, 11).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "=5, " & obj.Offset(myRow, 11).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "=7), " & obj.Offset(myRow, 18).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "+(" & Range("q1").Address & "*cos(" & _
        obj.Offset(myRow, 12).Address(RowAbsolute:=False, ColumnAbsolute:=True) & _
        ")), 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, 18).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "+" & Range("q1").Address & ", " & _
        obj.Offset(myRow, 18).Address(RowAbsolute:=False, ColumnAbsolute:=False) & ")))" ' ey2'(X')

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

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

    ex1primeR = "=if(or(" & obj.Offset(myRow, 11).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "=1, " & obj.Offset(myRow, 11).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "=6, " & obj.Offset(myRow, 11).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "=8), " & obj.Offset(myRow, 15).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "+(" & Range("q1").Address & "*cos((2*pi()/4)-" & _
        obj.Offset(myRow, 12).Address(RowAbsolute:=False, ColumnAbsolute:=True) & _
        ")), if(or(" & 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) & _
        "=7), " & obj.Offset(myRow, 15).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "+(" & Range("q1").Address & "*sin(" & _
        obj.Offset(myRow, 12).Address(RowAbsolute:=False, ColumnAbsolute:=True) & _
        ")), " & obj.Offset(myRow, 15).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "+" & Range("q1").Address & "))" ' ex1''(U')

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

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

    ex2primeR = "=if(or(" & obj.Offset(myRow, 11).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "=1, " & obj.Offset(myRow, 11).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "=6, " & obj.Offset(myRow, 11).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "=8), " & obj.Offset(myRow, 16).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "+(" & Range("q1").Address & "*cos((2*pi()/4)-" & _
        obj.Offset(myRow, 12).Address(RowAbsolute:=False, ColumnAbsolute:=True) & _
        ")), if(or(" & 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) & _
        "=7), " & obj.Offset(myRow, 16).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "+(" & Range("q1").Address & "*sin(" & _
        obj.Offset(myRow, 12).Address(RowAbsolute:=False, ColumnAbsolute:=True) & _
        ")), " & obj.Offset(myRow, 16).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "+" & Range("q1").Address & "))" ' ex2''(V')

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

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

    ey1primeR = "=if(or(" & obj.Offset(myRow, 11).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "=1, " & obj.Offset(myRow, 11).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "=6, " & obj.Offset(myRow, 11).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "=8), " & obj.Offset(myRow, 17).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "+(" & Range("q1").Address & "*sin((2*pi()/4)-" & _
        obj.Offset(myRow, 12).Address(RowAbsolute:=False, ColumnAbsolute:=True) & _
        ")), if(or(" & 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) & _
        "=7), " & obj.Offset(myRow, 17).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "-(" & Range("q1").Address & "*cos(" & _
        obj.Offset(myRow, 12).Address(RowAbsolute:=False, ColumnAbsolute:=True) & _
        ")), " & obj.Offset(myRow, 17).Address(RowAbsolute:=False, ColumnAbsolute:=False) & "))" ' ey1''(W')

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

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

    ey2primeR = "=if(or(" & obj.Offset(myRow, 11).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "=1, " & obj.Offset(myRow, 11).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "=6, " & obj.Offset(myRow, 11).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "=8), " & obj.Offset(myRow, 18).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "+(" & Range("q1").Address & "*sin((2*pi()/4)-" & _
        obj.Offset(myRow, 12).Address(RowAbsolute:=False, ColumnAbsolute:=True) & _
        ")), if(or(" & 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) & _
        "=7), " & obj.Offset(myRow, 18).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
        "-(" & Range("q1").Address & "*cos(" & _
        obj.Offset(myRow, 12).Address(RowAbsolute:=False, ColumnAbsolute:=True) & _
        ")), " & obj.Offset(myRow, 18).Address(RowAbsolute:=False, ColumnAbsolute:=False) & "))" ' ey2''(X')

End Function

Step 9グラフの完成

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

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

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

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

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

また「gap」は多重辺の間に作る間隙の目安です。座標と対応し，大きくするほど間隙は広がります。

scrollable

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

Step 10［付記］アイコン・コメントを加える場合

エッジの上にアイコンやコメントを加える場合，あらたにもう1つ，グラフの系列を増やしてやるのが手っ取り早いかと思います。

具体的には若干的外れな言い方になりますが，エッジの中点を下図のようにして求め(label-x, label-y: 下図のように1本の場合と2本の場合で計算式を変えたほうがbetterです。たぶん)

scrollable

これを系列のx，yとしてあらたにグラフに追加します。

結果，下図の青い×点で示す座標ができるので，このマーカーを任意のものたとえば何らの図形やOffice365で最近になって実装されたSVGアイコンなどに，ポイントの別に置き換えれば感情などの表現をなすことができます。

またコメントを加えたい場合には，表示させたい内容を別途用意し，これを先のあたらしい系列の「データラベル」として示します。このとき，この系列のマーカーを非表示(「マーカーなし」)としてしまえば，違和感を残しません。

また，Step 0で提示したようなエッジに沿ったコメントを作りたい場合，前提として，すでにシートの上にある「rad」列の値を度数法の表記に書き換え，

これらをデータラベルの書式設定にて個別のポイントごとに反映させてやることが必要です。

このとき，各エッジの起点を中心として1ないしは3象限に向かうものについては，値の頭にマイナスを加えて指定する必要があります。

その他の参照