xlsxやCSVをjsonに変換したい
htmlやjavascriptでグラフにする際には、jsonに変換する必要があります。手で入力するのはしんどいものがあります。excel VBAで一気に変換します。
このデータが、
こうなります。
[{"myid":1,"name":"dog","score":89},
{"myid":2,"name":"cat","score":59},
{"myid":3,"name":"bird","score":79}]VBAのスクリプトは、以下です。自動でデータ型を判断して、数字型は””なしで、その他は””ありで辞書型データを作成していきます。
Sub tojson()
Dim lastrow As Integer
lastrow = Range("A1").End(xlDown).Row
Dim lastcolumn As Integer
lastcolumn = Range("A1").End(xlToRight).Column
Dim numberofdata As Integer
numberofdata = lastrow - 1
Dim colname() As Variant
ReDim colname(1 To lastcolumn) As Variant
colname = Range(Cells(1, 1), Cells(1, lastcolumn)).Value
Dim dataframe() As Variant
ReDim dataframe(1, 1 To numberofdata) As Variant
dataframe = Range(Cells(2, 1), Cells(lastrow, lastcolumn)).Value
Dim datatype() As Variant
ReDim datatype(1 To lastcolumn) As Variant
For i = 1 To lastcolumn
datatype(i) = VarType(dataframe(1, i))
Next i
Dim jsondata() As Variant
ReDim jsondata(1 To 1, 1 To numberofdata) As Variant
If lastcolumn > 1 Then
For i = 1 To numberofdata
If ((1 < datatype(1)) And (datatype(1) < 7)) Then 'in case of number
jsondata(1, i) = Chr(34) & colname(1, 1) & Chr(34) & ":" & dataframe(i, 1)
Else ' in case of not number
jsondata(1, i) = Chr(34) & colname(1, 1) & Chr(34) & ":" & Chr(34) & dataframe(i, 1) & Chr(34)
End If
For k = 2 To lastcolumn
If ((1 < datatype(k)) And (datatype(k) < 7)) Then 'in case of number
jsondata(1, i) = jsondata(1, i) & "," & Chr(34) & colname(1, k) & Chr(34) & ":" & dataframe(i, k)
Else
jsondata(1, i) = jsondata(1, i) & "," & Chr(34) & colname(1, k) & Chr(34) & ":" & Chr(34) & dataframe(i, k) & Chr(34)
End If
Next k
jsondata(1, i) = "{" & jsondata(1, i) & "}"
Next i
Else
For i = 1 To numberofdata
If ((1 < datatype(1)) And (datatype(1) < 7)) Then
jsondata(1, i) = "{" & colname(1, 1) & ":" & dataframe(i, 1) & "}"
Else
jsondata(1, i) = "{" & colname(1, 1) & ":" & Chr(34) & dataframe(i, 1) & Chr(34) & "}"
End If
Next i
End If
Dim resultjson As String
resultjson = "[" & jsondata(1, 1)
For s = 2 To numberofdata
resultjson = resultjson & "," & vbCrLf & jsondata(1, s)
Next s
resultjson = resultjson & "]"
With CreateObject("ADODB.Stream")
.Type = 2
.Charset = "utf-8"
.Open
.WriteText resultjson, 1
.SaveToFile ThisWorkbook.Path & "/" & "data.json", 2
.Close
End With
End Sub