Excel VBAで表からJSON出力をやってみた

https://qiita.com/tomgoodsun/items/9b6ea92dc3e2c26e70fe

VBAでもやってみました。
まずVBAを書くのは非常に面倒なので、ChatGPTに要件だけ伝えてプログラムを出力してもらって、それを少し調整して使いました。
VBAでJSONを作るのは非常に辛いです。
そのため[VBA-JSON](https://github.com/VBA-tools/VBA-JSON)というライブラリを使うことにしました。

## 準備

お題はPython in Excelと同じです。

![excel-vba-json_01.gif](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/131218/19303be4-4c17-3915-41cf-17f22bb6bbf8.gif)

以下をダウンロードしてそれぞれVisual Basicエディタに読み込んでおきます。
「ファイル」→「ファイルのインポート」でそれぞれ`JsonConverter.bas`と`Dictionary.cls`を読み込みます。

- [VBA-JSON](https://github.com/VBA-tools/VBA-JSON)
- [VBA-Dictionary](https://github.com/VBA-tools/VBA-Dictionary)（VBA-JSONが使用する）

![Screenshot 2024-11-19 024200.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/131218/65bcdfb8-b97e-8fb5-ad8b-de2d32afff16.png)

今回書いたコードは以下のようなものです。

```vb
Sub GenerateJSONUsingVBAJSONSkipEmpty()
    Dim ws As Worksheet
    Dim tbl As ListObject
    Dim shp As Shape
    Dim jsonStr As String
    Dim rowData As Dictionary
    Dim r As Long, c As Long
    Dim cellValue As Variant

    ' Set references to the worksheet, table, and shape
    Set ws = ThisWorkbook.Sheets("Sheet1") ' Change "Sheet1" to your worksheet name
    Set tbl = ws.ListObjects("list")    ' Change "MyTable" to your table's name
    Set shp = ws.Shapes("result_box")     ' Change "JsonTextBox" to your text box's name

    ' Initialize a new collection to hold each row's Dictionary
    Dim rowsCollection As New Collection

    ' Loop through each row in the table
    With tbl
        For r = 1 To .ListRows.Count
            Set rowData = New Dictionary
            For c = 1 To .ListColumns.Count
                cellValue = .DataBodyRange(r, c).Value
                ' Skip empty cells
                If Not IsEmpty(cellValue) Then
                    ' Add cell data directly without further string manipulation
                    rowData(.ListColumns(c).Name) = cellValue
                End If
            Next c
            ' Only add the row to the collection if it has data
            If rowData.Count > 0 Then
                rowsCollection.Add rowData
            End If
        Next r
    End With

    ' Convert the collection of dictionaries to a JSON string
    jsonStr = JsonConverter.ConvertToJson(rowsCollection, Whitespace:=2)

    ' Assign the JSON string to the text box
    shp.TextFrame.Characters.Text = jsonStr
End Sub
```

テキストの図形オブジェクトに`result_box`という名前をつけています。そこに出力します。
あとはボタンを配置して`GenerateJSONUsingVBAJSONSkipEmpty`を割り当てると機能するようになります。

## JSONの仕様に忠実すぎて

出力されたJSONは以下のようになっています。

```json
[
  {
    "prefecture": "\u5317\u6D77\u9053",
    "city": "\u672D\u5E4C\u5E02"
  },
  {
    "prefecture": "\u5BAE\u57CE\u770C",
    "city": "\u4ED9\u53F0\u5E02"
  }
]
```
マルチバイト文字がちゃんとエンコードされています。
さすがに見づらいので、なんとかならないかと考えた結果`VBA-JSON`を書き換えることにしました。

そこで問題となるのはダブルクォーテーションの始末です。
JavaScriptだと以下のようにエスケープされていました。
今回はあまり考えたくないので、ダブルクォーテーションは除去することとします。

```javascript
let a = {'test': 'a"\"\f'}
JSON.stringify(a); // '{"test":"a\\"\\"\\f"}'
```

JsonConverterの240行目付近、`json_Encode`が該当する箇所になります。
以下のように書き換えました。
```vb
            'ConvertToJson = """" & json_Encode(JsonValue) & """"
            ConvertToJson = """" & Replace(JsonValue, """", "") & """"
```
![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/131218/fc160468-511d-72b9-49c4-2b2c4db258f9.png)

# まとめ
JSONのVBAライブラリがあるのが救いでした。
これがなかったら、かなり詰んでました。
とはいえ、このご時世VBAは書きたくない・・・
なんというか書いているだけでいろんなものがマイナスになっていく感じがしちゃいます。
JavaScriptベースの言語がありがたいかな。