実験情報集約フォーマットでのJSON活用法

## 背景
組成物開発をチームで行う場合、データを一元管理するために、レシピや実験結果を各担当者ごとにExcelテンプレートに入力することが考えられます。
そのようなテンプレートを作っている際、JSONで一部データを保持したら便利だなと思ったことが結構あったので紹介します。


## 組成情報の集約に使う
### 可変列
実験結果を記載するフォーマットの列（原料/測定）は下図の2つのように、作業者ごとに可変にしておくことが多いと思います。なぜかというと、使用する可能性のあるすべての項目をあらかじめ列として用意しておくのは視認性を損ないますし、途中で新しい列を使用したくなることも十分考えられます。
一方で、厳密には共通のフォーマットを使用するわけではないので、最終的にこれをRDBなどに格納することが面倒になります。
そもそも論的には縦持ちが最適ですが、それはそれでサンプル間の比較がやりにくいので作業者にあまり受け入れられないでしょう。そこで考えられるのが、「可変横持ち表＋JSON」の形です。


![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/3471244/9761fa81-98ca-4980-82e8-3f148ffcf379.png)


### JSON化関数
例えばこのようなユーザー定義関数を作っておいて、
```vb:
Function JoinAsJSON(arr1 As Range, arr2 As Range) As String
    Dim result As String
    Dim i As Integer
    Dim value1 As String
    Dim value2 As String
    
    ' 初期化
    result = "{"
    
    ' 配列のサイズを確認し、ループ処理を実行
    For i = 1 To arr1.Cells.Count
        value1 = arr1.Cells(1, i).Value
        value2 = arr2.Cells(1, i).Value
        
        ' 空でない値をチェック
        If value2 <> "" Then
            ' 先頭要素でなければ、カンマを追加
            If result <> "{" Then
                result = result & ","
            End If
            ' 値をJSON形式に変換
            result = result & """" & value1 & """:" & value2
        End If
    Next i
    
    ' 結果を閉じる
    result = result & "}"
    
    ' 関数の戻り値として設定
    JoinAsJSON = result
End Function
```
こんな感じで1列持っておくようにしておくと、作業者ごとに列構成が違っても組成の情報は必ず1セルに収まっているという状態が作れるので、集約はどうとでもなりそうです。
![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/3471244/f2909955-b957-42d4-9586-cbe949ce2af9.png)


### ほかの利用法
パースする関数があると、Excel上での情報の取り回しがよくなるので、これもメリットです。
(下記コード例は生成AIに作ってもらいました。)
```vb:JSONを配列に
Function JsonToCrossTable(jsonRange As Range) As Variant
    Dim dicts() As Object
    Dim uniqueKeys As Object
    Dim cell As Range
    Dim i As Integer, j As Integer
    
    ' 配列の準備
    ReDim dicts(1 To jsonRange.Cells.Count)
    Set uniqueKeys = CreateObject("Scripting.Dictionary")
    
    ' 各セルの JSON を解析して辞書に格納
    i = 1
    For Each cell In jsonRange
        If cell.value <> "" Then
            Set dicts(i) = ParseJson(cell.value) ' JSON
            If Not dicts(i) Is Nothing Then
                ' ユニークなキーを収集
                For Each key In dicts(i).Keys
                    If Not uniqueKeys.exists(key) Then uniqueKeys.Add key, key
                Next
            End If
        End If
        i = i + 1
    Next cell

    ' 出力用の2次元配列を作成
    Dim outputArray() As Variant
    Dim rowCount As Integer, colCount As Integer
    
    rowCount = jsonRange.Cells.Count
    colCount = uniqueKeys.Count
    ReDim outputArray(0 To rowCount, 0 To colCount - 1)

    ' ヘッダー行を設定
    j = 0
    For Each key In uniqueKeys.Keys
        outputArray(0, j) = key
        j = j + 1
    Next key

    ' データ行を設定
    For i = 1 To rowCount
        j = 0
        For Each key In uniqueKeys.Keys
            If Not dicts(i) Is Nothing Then
                If dicts(i).exists(key) Then
                    outputArray(i, j) = dicts(i)(key)
                Else
                    outputArray(i, j) = ""
                End If
            Else
                outputArray(i, j) = ""
            End If
            j = j + 1
        Next key
    Next i

    ' 結果を返す
    JsonToCrossTable = outputArray
End Function

'JSONを解析する関数
Function ParseJson(jsonString As String) As Object
    Dim dict As Object
    Dim pairs As Variant, pair As Variant
    Dim key As String, value As String
    
    Set dict = CreateObject("Scripting.Dictionary")
    
    ' 文字列の前後の { } を削除
    jsonString = Trim(jsonString)
    If Left(jsonString, 1) = "{" Then jsonString = Mid(jsonString, 2)
    If Right(jsonString, 1) = "}" Then jsonString = Left(jsonString, Len(jsonString) - 1)
    
    ' , で分割
    pairs = Split(jsonString, ",")
    
    ' 各キーと値を取得
    For Each pair In pairs
        pair = Trim(pair)
        key = Trim(Split(pair, ":")(0))
        value = Trim(Split(pair, ":")(1))
        
        ' キーと値の整形
        key = Replace(key, """", "") ' " を削除
        value = Replace(value, """", "") ' " を削除
        If IsNumeric(value) Then value = CDbl(value) ' 数値に変換
        
        ' Dictionary に追加
        dict.Add key, value
    Next pair
    
    ' 結果を返す
    Set ParseJson = dict
End Function

```

JSON列だけコピーすれば比較が簡単にできるので、気に入ってます。
![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/3471244/1a4a2ad4-cddf-440b-8fd7-490edb449be7.png)
![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/3471244/b230c738-9728-4fa7-8983-0139f21c3382.png)

### ほかの利用法2
「フィルムサンプルの位置毎の厚み」といったような、人、サンプル、実験ごとに入力と出力のデータフォーマットが不定な特性を考えます。こういうのは本来縦持ちのデータとするべきだとは思いますが、1行に1サンプルの情報を入れたいという材料技術者の気持ちもとても分かります。これもJSONで保持しておくことにすると再利用しやすくて楽です。（特に、実験や作業者を横断する分析がやりやすい）
![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/3471244/648f8b43-f21d-49a9-b9af-71e0aad0dbd6.png)

![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/3471244/14ae53d9-ace6-4588-ba86-8b2639705277.png)