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

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

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

   A           B
1 firstName   age
2 Alice       22
3 Bob         33

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

[{firstName: 'Alice', age: 22}, {firstName: 'Bob', age: 33}]
Источник

5 ответов

Решение

Этот код 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 /Macros с помощью ALT+F11.

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

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

Источник

Я объединил ответ jcbermu и ответ JanHudecek с версией UTF-8 ( фрагменты, найденные здесь), которая хранит акценты и другие достоинства Unicode.

Сохраняет файл рядом с файлом активной книги, но с .json расширение файла. Это быстро. Его можно легко отформатировать в VS Code (Shift+Alt+F).

Чтобы использовать его, нажмите Alt+F11, чтобы перейти к редактору кода VBA, откройте код активной рабочей таблицы и вставьте его в окно кода. Нажмите F5, чтобы запустить.

Public Sub tojson()
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    jsonFilename = fso.GetBaseName(ActiveWorkbook.Name) & ".json"
    fullFilePath = Application.ActiveWorkbook.Path & "\" & jsonFilename

    Dim fileStream As Object
    Set fileStream = CreateObject("ADODB.Stream")
    fileStream.Type = 2 'Specify stream type - we want To save text/string data.
    fileStream.Charset = "utf-8" 'Specify charset For the source text data.
    fileStream.Open 'Open the stream And write binary data To the object

    Dim wkb As Workbook
    Set wkb = ThisWorkbook

    Dim wks As Worksheet
    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
    fileStream.WriteText "["
    dq = """"
    escapedDq = "\"""
    For j = 2 To lrow
        For i = 1 To lcolumn
            If i = 1 Then
                fileStream.WriteText "{"
            End If
            cellvalue = Replace(wks.Cells(j, i), dq, escapedDq)
            fileStream.WriteText dq & titles(i) & dq & ":" & dq & cellvalue & dq
            If i <> lcolumn Then
                fileStream.WriteText ","
            End If
        Next i
        fileStream.WriteText "}"
        If j <> lrow Then
            fileStream.WriteText ","
        End If
    Next j
    fileStream.WriteText "]"
    fileStream.SaveToFile fullFilePath, 2 'Save binary data To disk
    a = MsgBox("Saved to " & fullFilePath, vbOKOnly)
End Sub
Источник

Если вы хотите, чтобы сценарий действительно завершился до того, как вы стали пенсионером, я предлагаю немедленно записать в выходной файл вместо конкатенации строку 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
Источник
  1. сохранить как CSV

  2. конвертировать в JSON с млр

    mlr --icsv --ifs ';' --ojson cat exported.csv > out.json

Если вы хотите преобразовать jsonfile. Вы могли бы использовать JQ

jq -s '[.[]|{newfieldname: .oldone, "phone": "123"}]' out.json > transformed.json
Источник

Если вам просто нужно простое одноразовое преобразование в JSON, для этого есть веб-сайты.

Я использовал это с хорошими результатами:https://www.convertcsv.com/csv-to-json.htm

Источник
Другие вопросы по тегам