将 Excel 工作表另存为 JSON 文件

Question

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

例如，源表可能如下所示：

   A           B
1 firstName   age
2 Alice       22
3 Bob         33

和保存的 JSON：

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

Answer 1

我将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