背景
組成物開発をチームで行う場合、データを一元管理するために、レシピや実験結果を各担当者ごとにExcelテンプレートに入力することが考えられます。
そのようなテンプレートを作っている際、JSONで一部データを保持したら便利だなと思ったことが結構あったので紹介します。
組成情報の集約に使う
可変列
実験結果を記載するフォーマットの列(原料/測定)は下図の2つのように、作業者ごとに可変にしておくことが多いと思います。なぜかというと、使用する可能性のあるすべての項目をあらかじめ列として用意しておくのは視認性を損ないますし、途中で新しい列を使用したくなることも十分考えられます。
一方で、厳密には共通のフォーマットを使用するわけではないので、最終的にこれをRDBなどに格納することが面倒になります。
そもそも論的には縦持ちが最適ですが、それはそれでサンプル間の比較がやりにくいので作業者にあまり受け入れられないでしょう。そこで考えられるのが、「可変横持ち表+JSON」の形です。
JSON化関数
例えばこのようなユーザー定義関数を作っておいて、
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セルに収まっているという状態が作れるので、集約はどうとでもなりそうです。
ほかの利用法
パースする関数があると、Excel上での情報の取り回しがよくなるので、これもメリットです。
(下記コード例は生成AIに作ってもらいました。)
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列だけコピーすれば比較が簡単にできるので、気に入ってます。
ほかの利用法2
「フィルムサンプルの位置毎の厚み」といったような、人、サンプル、実験ごとに入力と出力のデータフォーマットが不定な特性を考えます。こういうのは本来縦持ちのデータとするべきだとは思いますが、1行に1サンプルの情報を入れたいという材料技術者の気持ちもとても分かります。これもJSONで保持しておくことにすると再利用しやすくて楽です。(特に、実験や作業者を横断する分析がやりやすい)