• 虹色ミツバチ
  • freoカスタマイズメモ、テンプレート・プラグイン配布/officeTIPS
検索プラグイン
虹色ミツバチ

> Entry >MOS>Microsoft Office Excel>マクロ/VBA> ExcelのリストをJSONに変換するマクロ

【MOS】【Microsoft Office Excel】【マクロ/VBA】ExcelのリストをJSONに変換するマクロ

JSONとはJavaScript Object Notationの略で、配列で書かれたテキスト形式のファイルです。
JSONファイルをサーバーに上げるとHTMLに出力することもできるので、HTMLタグを知らない人でもJSONファイルを変更できれば簡単にサイトを更新することができます。

JSONファイルには決まった書式ルールがあるので、不慣れな人が作成するのは少し難しいかもしれません。
今回はExcelのリストからJSONファイルを生成するマクロを作成してみました。

Excelリスト例

たとえばこんなリストがあるとします。

Excelリスト例

このリストをJSONに生成するマクロは下記の通りです。

VBA例
Sub make_json()
 
ThisWorkbook.Activate
'変数定義
    Const adTypeBinary = 1
    Const adTypeText = 2
    Const adSaveCreateOverWrite = 2
    
    Dim fileName, fileFolder, fileFile As String
    Dim isFirstRow As Boolean
    Dim i, u As Long
     
'最終行取得
    Dim maxRow, maxCol As Long
    If Len(ActiveSheet.Range("A2").Value) = 0 Then
        maxRow = 0
    ElseIf Len(ActiveSheet.Range("A3").Value) = 0 Then
        maxRow = 1
    Else
        maxRow = ActiveSheet.Range("A1").End(xlDown).Row
    End If
'最終列取得
    maxCol = Range("A1").End(xlToRight).Column
     
 
'JSONファイル定義
    fileName = ActiveSheet.Name            'JSONファイル名を指定
    fileFolder = ThisWorkbook.Path         '新しいファイルの保存先フォルダ名
    fileFile = fileFolder & "\" & fileName '新しいファイルをフルパスで定義
    
    '同名のJSONファイルが既にある場合は削除する
    If Dir(fileFile) <> "" Then
        Kill fileFile
    End If
 
'JSON作成
    'オブジェクトを用意する
    Dim txt As Object
    Set txt = CreateObject("ADODB.Stream")
    txt.Charset = "UTF-8"
    txt.Open
     
    'JSON開始タグ
    isFirstRow = True
    txt.Writetext "[" & vbCrLf, adWriteLine
     
    'リストをオブジェクトに書き込む
    For i = 2 To maxRow
        '1行目か確認して2行目以降の場合は行頭に","を挿入
        If isFirstRow = True Then
            isFirstRow = False
        Else
            txt.Writetext "," & vbCrLf, adWriteLine
        End If
         
        '行の開始タグを挿入
            txt.Writetext vbTab & "{" & vbCrLf, adWriteLine
         
            For u = 1 To maxCol
                '最終列でない場合は","を挿入
                If u = maxCol Then
                    txt.Writetext vbTab & vbTab & """" & Cells(1, u).Value & """" & ":" & """" & Cells(i, u).Value & """" & vbCrLf, adWriteLine
                Else
                    txt.Writetext vbTab & vbTab & """" & Cells(1, u).Value & """" & ":" & """" & Cells(i, u).Value & """" & "," & vbCrLf, adWriteLine
                End If
            Next u
         
        '行の閉じタグを挿入
        txt.Writetext vbTab & "}", adWriteLine
    Next
     
    'JSON終了タグ
    txt.Writetext vbCrLf, adWriteLine
    txt.Writetext "]" & vbCrLf, adWriteLine
     
    'BOMを削除する
    txt.Position = 0
    txt.Type = adTypeBinary
    txt.Position = 3
 
    Dim tmp() As Byte
    tmp = txt.Read
    txt.Close
 
    txt.Open
    txt.Write tmp
     
     
    'オブジェクトの内容をファイルに保存
    txt.SaveToFile fileFile, adSaveCreateOverWrite
     
    'オブジェクトを閉じる
    txt.Close
     
 
    MsgBox ("ファイルを生成しました。")
     
 
End Sub

最終行と最終列を自動取得し、JSONを生成します。
JSONのファイル名はシート名を取得して作成します。
例えば「list.json」という名前のjsonにしたい場合、シート名を「list.json」という名前にしてください。

同名のファイルがある場合は削除して新規に保存します。
項目名として利用するため、リストシートの1行目にはそれぞれの項目名を入力してください。

ワンポイント

上記コードを利用するとjsonはUTF8のBOM無しで生成されます。
BOM有りのファイルはプログラムでの読み込み時にエラーになる場合があるので、BOM無しに設定しています。

JSON生成

上記のマクロを実行すると、下記のようなJSONが生成されます。

[
    {
        "num":"1",
        "name":"イチゴ",
        "url":"http://hoge.net"
    },
    {
        "num":"2",
        "name":"リンゴ",
        "url":""
    },
    {
        "num":"3",
        "name":"バナナ",
        "url":"http://hoge.com"
    }
]
まとめ

閉じタグの位置や区切り文字の位置・有無など、ルールに沿った書き方をしないといけないので、不慣れな人が触る場合は、このように自動生成するマクロなどを活用するといいかもしれません。

ページ移動

関連記事

ユーティリティ

Twitter

ページ上部へ