ビールが飲みたい。

ゲーム開発の備忘録などを書きます。

続。Excelでマスターデータ作ってVBA使ってJsonで出力する

こちらの記事の続編的な物です。

eggame.hateblo.jp

今更ながらVBA-JSONなる便利なライブラリを使って、もっと簡単にJSON出力のためのコードを書ける事に気づいたため、続編として残しておきます。

VBA-JSONのインポートと参照設定

こちらのリポジトリからダウンロード。

VBEを開き、ファイル > インポートからJsonConverter.basをインポート。 標準モジュールにJsonConverterが作成されればオーケー。

このままだと日本語がエスケープされてしまうので、 JsonConverterをダブルクリックして中身のjson_Encode関数の

Case 0 To 31, 127 To 65535

Case 0 To 31, 127 

に書き換えましょう。

Windows版ですが)NewでDictionaryを使うため、 ツール > 参照設定 からMicrosoft Scripting Runtimeをチェック入れる。 Macの場合は確認していないのでGithubのREADMEに従って下さい。

ついでにMicrosoft ActiveX Data Objects x.x Libraryにチェック入れてなかったらどれかに入れる。 (僕は2.8をチェックしました。)

今回のテーブル

f:id:eggame:20200403160221p:plain

コードを書く

コメントをいっぱい書いたので行数使ってますが、 コメントを消したら大分短くわかりやすいです。

Option Explicit

Sub CreateJson()
  
  Const sheetName = "item", root = "item"
  Dim targetFilePath As String
  Dim row As Integer, col As Integer, count As Integer
  
  'Jsonにコンバートするためのオブジェクトを用意するわけですが、
  'Collectionは[]でくくられる配列が作成され、
  'Dictionaryは{}でくくられる連想配列が作成されます。
  
  '今回はJsonUtilityの仕様に合わせて
  '{ "item":[{"key":"value"}, {"key":"value"}] }のような形を目指すため
  '初っ端はDictionaryをSetします。
  Dim jo As New Dictionary
  
  '出力パスを作成
  targetFilePath = ThisWorkbook.path & "\item.json"

  '{"item":[]} の形にする
  jo.Add root, New Collection
  
  With Worksheets(sheetName)
    
    'ループを開始する行番号を入れて下さい。
    row = 2 '行
    col = 1 '列
    
    'Collectionのindexは1からスタートだけど
    '関係が近い場所でカウントを進めたかったため、
    '初期値は0にしている
    count = 0
    
    Do
      jo(root).Add New Dictionary '配列に連想配列を追加
      count = count + 1           '配列のindexを進める
      
      'ここで連想配列に詰める
      Do
        jo(root)(count).Add .Cells(1, col).value, .Cells(row, col).value
        col = col + 1
      '空白のセルに当たるまで、列をループする
      Loop Until IsEmpty(.Cells(1, col).value) = True
      
      col = 1 'ループ抜けたら列カウント初期化
      row = row + 1
    '空白のセルに当たるまで、行をループする
    Loop Until IsEmpty(.Cells(row, 1).value) = True
  
  End With
  
  'joをJsonにコンバートしつつ、ファイルに書き込む
  WriteToFile JsonConverter.ConvertToJson(jo, Whitespace:=2), targetFilePath
  
  MsgBox ("出力完了")
End Sub

'ファイルに書き込む専用の関数
Private Function WriteToFile(ByVal json As String, ByVal path As String)
  Dim stm As New ADODB.Stream
  
  'ファイルが存在したら一旦削除
  If Dir(path) <> "" Then
    Kill path
  End If
  
  stm.Charset = "UTF-8"
  stm.LineSeparator = adLF
  stm.Open

  stm.WriteText json, 1
  stm.SaveToFile path, 2
  stm.Close
End Function

JSON出力結果

{
  "item": [
    {
      "data_id": 1,
      "data_name": "木の棒",
      "description": "故郷の木の枝を拾いました",
      "hp": 0,
      "attack": 1,
      "defense": 1,
      "speed": 1,
      "assetBundleName": "item_wood"
    },
    {
      "data_id": 2,
      "data_name": "竹やり",
      "description": "一般的な武器です",
      "hp": 0,
      "attack": 2,
      "defense": 2,
      "speed": 2,
      "assetBundleName": "item_bamboo_spear"
    },
    {
      "data_id": 3,
      "data_name": "錆びたナイフ",
      "description": "この龍の紋章は何でしょう。",
      "hp": 0,
      "attack": 3,
      "defense": 1,
      "speed": 3,
      "assetBundleName": "item_rested_knife"
    },
    {
      "data_id": 4,
      "data_name": "なべのふた",
      "description": "投げたい。",
      "hp": 5,
      "attack": 0,
      "defense": 5,
      "speed": 0,
      "assetBundleName": "item_pot_lid"
    }
  ]
}

備考

stringを連結していくより処理は重くなりますが、コードはとてもスッキリします。