☰

将 Excel 表保存为 JSON 文件

tag-icon • tag-icon microsoft-excel json
将 Excel 表保存为 JSON 文件

有没有简单的方法可以将简单的 Excel 表转换为 JSON 文件？

例如源表可能如下所示：

   A           B
1 firstName   age
2 Alice       22
3 Bob         33

以及保存的 JSON：

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

答案1

我已经结合jcbermu 的回答 和JanHudecek 的回答 使用 UTF-8 版本（片段在这里) 保留了重音符号和其他 Unicode 优点。

它将文件保存在活动工作簿文件旁边，但.json文件扩展名是 。速度很快。它可以在 VS Code ( ++ Shift)中轻松格式化。AltF

要使用它，请按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

答案2

如果您希望脚本在您退休之前真正完成，我建议立即写入输出文件，而不是连接字符串变量：

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

答案3

该 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

使用ALT+打开 VBA/宏F11。

在左侧双击工作表，在右侧粘贴代码。

将变量设置savename为您想要的 json 文件的名称，就这样。

答案4

如果您只需要简单地一次性转换为 JSON，那么有一些网站可以做到这一点。

我用过这个，效果很好： https://www.convertcsv.com/csv-to-json.htm

相关内容