VBAでExcelの表をJSON形式に変換する
Excelの次のような表をJSON形式にするVBAです。
| id | name | date |
|---|---|---|
| 1 | a1 | 20081010 |
| 2 | a2 | 20081011 |
| 3 | a3 | 20081012 |
| 4 | a4 | 20081013 |
| 5 | a5 | 20081014 |
| 6 | a6 | 20081015 |
| 7 | a7 | 20081016 |
| 8 | a8 | 20081017 |
| 9 | a9 | 20081018 |
| 10 | a10 | 20081019 |
新しいシートを開き、そこにJSON形式のテキストを出力します。
Sub 表をJSON形式にする()
Dim arr(1000)
Dim gyo, retsu, gyosu, cnt As Long
Dim lin, temp As String
arr(0) = "["
gyo = 2
Do
retsu = 1
lin = ""
Do
temp = Chr(34) & Cells(1, retsu) & Chr(34) & ":" & Chr(34) & Cells(gyo, retsu) & Chr(34)
lin = lin & "," & temp
retsu = retsu + 1
Loop Until Cells(gyo, retsu) = ""
lin = Mid(lin, 2)
arr(gyo - 1) = "{" & lin & "},"
gyo = gyo + 1
Loop Until Cells(gyo, 1) = ""
arr(gyo - 2) = Left(arr(gyo - 2), Len(arr(gyo - 2)) - 1)
arr(gyo - 1) = "]"
gyosu = gyo
Sheets.Add
For cnt = 1 To gyosu
Cells(cnt, 1) = arr(cnt - 1)
Next cnt
End Sub
Dim arr(1000)
Dim gyo, retsu, gyosu, cnt As Long
Dim lin, temp As String
arr(0) = "["
gyo = 2
Do
retsu = 1
lin = ""
Do
temp = Chr(34) & Cells(1, retsu) & Chr(34) & ":" & Chr(34) & Cells(gyo, retsu) & Chr(34)
lin = lin & "," & temp
retsu = retsu + 1
Loop Until Cells(gyo, retsu) = ""
lin = Mid(lin, 2)
arr(gyo - 1) = "{" & lin & "},"
gyo = gyo + 1
Loop Until Cells(gyo, 1) = ""
arr(gyo - 2) = Left(arr(gyo - 2), Len(arr(gyo - 2)) - 1)
arr(gyo - 1) = "]"
gyosu = gyo
Sheets.Add
For cnt = 1 To gyosu
Cells(cnt, 1) = arr(cnt - 1)
Next cnt
End Sub
最近のコメント