ExcelのテーブルをJSON形式に変換するマクロ
ある目的があって試しに作ってみたところ簡単にできたものの実際には使わなかったマクロを紹介します。
ExcelのテーブルをJSON形式に変換するマクロです。
次のような表があったとします。
これを次のようなJSON形式に変換し出力します。
[{
"ID": "1",
"名前": "鈴木",
"得点": "91"
}, {
"ID": "2",
"名前": "田中",
"得点": "86"
}, {
"ID": "3",
"名前": "山本",
"得点": "87"
}, {
"ID": "4",
"名前": "高橋",
"得点": "78"
}]
"ID": "1",
"名前": "鈴木",
"得点": "91"
}, {
"ID": "2",
"名前": "田中",
"得点": "86"
}, {
"ID": "3",
"名前": "山本",
"得点": "87"
}, {
"ID": "4",
"名前": "高橋",
"得点": "78"
}]
実際は「[{"ID":"1","名前":"鈴木","得点":"91"},{"ID":"2","名前":"田中","得点":"86"},{"ID":"3","名前":"山本","得点":"87"},{"ID":"4","名前":"高橋","得点":"78"}]」のように改行はありません。
マクロ
マクロは次の通りです。
Sub 表をJSON形式に()
arrs = Cells(1, 1).CurrentRegion '1から行数まで、1から列数まで
len_row = UBound(arrs, 1) '行数
len_col = UBound(arrs, 2) '列数
ReDim heads(len_col - 1) '見出し、0から列数-1まで
ReDim recs(len_row - 2) 'レコード、0から行数-2まで
'データの取得とJSONの生成
For c = 1 To len_col
'1行目の各セルを見出しとして取得。
heads(c - 1) = arrs(1, c)
Next c
For r = 2 To len_row
'2行目から最下行まで処理。
ReDim temps(len_col - 1) '0から列数-1まで
For c = 1 To len_col
'各行の各セルを取得し見出しと組み合わせる。
temps(c - 1) = Chr(34) & heads(c - 1) & Chr(34) & ":" & Chr(34) & arrs(r, c) & Chr(34)
Next c
recs(r - 2) = "{" & Join(temps, ",") & "}"
Next r
json = "[" & Join(recs, ",") & "]"
'ファイルの出力
fnsave = Application.GetSaveAsFilename("output.json", "JSON(*.json),*.json")
If fnsave = False Then Exit Sub
With CreateObject("ADODB.Stream")
.Type = 2
.Charset = "utf-8"
.Open
.WriteText json, 1
.SaveToFile fnsave, 2
.Close
End With
End Sub
arrs = Cells(1, 1).CurrentRegion '1から行数まで、1から列数まで
len_row = UBound(arrs, 1) '行数
len_col = UBound(arrs, 2) '列数
ReDim heads(len_col - 1) '見出し、0から列数-1まで
ReDim recs(len_row - 2) 'レコード、0から行数-2まで
'データの取得とJSONの生成
For c = 1 To len_col
'1行目の各セルを見出しとして取得。
heads(c - 1) = arrs(1, c)
Next c
For r = 2 To len_row
'2行目から最下行まで処理。
ReDim temps(len_col - 1) '0から列数-1まで
For c = 1 To len_col
'各行の各セルを取得し見出しと組み合わせる。
temps(c - 1) = Chr(34) & heads(c - 1) & Chr(34) & ":" & Chr(34) & arrs(r, c) & Chr(34)
Next c
recs(r - 2) = "{" & Join(temps, ",") & "}"
Next r
json = "[" & Join(recs, ",") & "]"
'ファイルの出力
fnsave = Application.GetSaveAsFilename("output.json", "JSON(*.json),*.json")
If fnsave = False Then Exit Sub
With CreateObject("ADODB.Stream")
.Type = 2
.Charset = "utf-8"
.Open
.WriteText json, 1
.SaveToFile fnsave, 2
.Close
End With
End Sub
必ず表の左上がA1セルになるようにします。
実行するとJSON(テキスト)の出力先を訊かれるので指定します。
蛇足
上の表で実行した場合、次の通りとなります。
arrs(1,1)は「ID」を指します。「Cells(1,1)」に相当します。
arrs(5,3)は「78」を指します。「Cells(5,3)」に相当します。
UBound(arrs,1)は「5」になります。表の行数になります。
UBound(arrs,2)は「3」になります。表の列数になります。
ありがとうございます！！！！！