Сохранение листа Excel в виде файла JSON

Есть ли простой способ конвертировать простую таблицу Excel в файл JSON?

Например, исходный лист может выглядеть так:

   A           B
1 firstName   age
2 Alice       22
3 Bob         33

и сохраненный JSON:

[{firstName: 'Alice', age: 22}, {firstName: 'Bob', age: 33}]

Этот код VBA будет работать:

Public Sub tojson()
    savename = "exportedxls.json"
    Dim wkb As Workbook
    Dim wks As Worksheet
    Set wkb = ThisWorkbook
    Set wks = wkb.Sheets(1)
    lcolumn = wks.Cells(1, Columns.Count).End(xlToLeft).Column
    lrow = wks.Cells(Rows.Count, "A").End(xlUp).Row
    Dim titles() As String
    ReDim titles(lcolumn)
    For i = 1 To lcolumn
        titles(i) = wks.Cells(1, i)
    Next i
    json = "["
    dq = """"
    For j = 2 To lrow
        For i = 1 To lcolumn
            If i = 1 Then
                json = json & "{"
            End If
            cellvalue = wks.Cells(j, i)
            json = json & dq & titles(i) & dq & ":" & dq & cellvalue & dq
            If i <> lcolumn Then
                json = json & ","
            End If
        Next i
        json = json & "}"
        If j <> lrow Then
            json = json & ","
        End If
    Next j
    json = json & "]"
    myFile = Application.DefaultFilePath & "\" & savename
    Open myFile For Output As #1
    Print #1, json
    Close #1
    a = MsgBox("Saved as " & savename, vbOKOnly)
End Sub

Откройте VBA / Макросы с ALT + F11 ,

С левой стороны дважды щелкните на листе, справа вставьте код.

Установите переменную savename на имя, которое вы хотите для файла JSON, и это все.

Если вы хотите, чтобы сценарий действительно завершился до того, как вы стали пенсионером, я предлагаю немедленно записать в выходной файл вместо конкатенации строку var:

Public Sub tojson()
    savename = "exportedxls.json"
    myFile = Application.DefaultFilePath & "\" & savename
    Open myFile For Output As #1
    Dim wkb As Workbook
    Dim wks As Worksheet
    Set wkb = ThisWorkbook
    Set wks = wkb.Sheets(1)
    lcolumn = wks.Cells(1, Columns.Count).End(xlToLeft).Column
    lrow = wks.Cells(Rows.Count, "A").End(xlUp).Row
    Dim titles() As String
    ReDim titles(lcolumn)
    For i = 1 To lcolumn
        titles(i) = wks.Cells(1, i)
    Next i
    Print #1, "["
    dq = """"
    For j = 2 To lrow
        For i = 1 To lcolumn
            If i = 1 Then
                Print #1, "{"
            End If
            cellvalue = wks.Cells(j, i)
            Print #1, dq & titles(i) & dq & ":" & dq & cellvalue & dq
            If i <> lcolumn Then
                Print #1, ","
            End If
        Next i
        Print #1, "}"
        If j <> lrow Then
            Print #1, ","
        End If
    Next j
    Print #1, "]"
    Close #1
    a = MsgBox("Saved as " & savename, vbOKOnly)
End Sub