将excel输入转换为json

Question

我正在尝试使用Excel中的以下输入提取json文件。

为此，我有一个如下代码（在VBA中）：

Public Sub ExceltoJson()

Dim rng As Range, items As New Collection, myitem As New Dictionary, i As Integer, cell
Set rng = Range("A1:A3")
i = 0
For Each cell In rng
    Debug.Print (cell.Value)
    myitem("CurrentPromo") = cell.Offset(1, 0).Value
    myitem("StartDateCP") = cell.Offset(2, 0).Value
    myitem("EndDateCP") = cell.Offset(3, 0).Value
    Set myitem = Nothing
    i = i + 1
    items.Add myitem
Next
'items.Add myitem
myfile = "C:\Users\gabriem\PycharmProjects\BigPromos" & "\json_vba.json"
Open myfile For Output As #1
Print #1, ConvertToJson(items, Whitespace:=2)
Close #1

End Sub

但是，我得到的结果是：

[{"StartDateCP": "PastPromo","EndDateCP": "DPE16"},{"CurrentPromo":"PastPromo","StartDateCP": "DPE16"},{}]

这不是我要找的。我需要每个标签及其独特的价值。

任何人都可以指导我吗？

非常感谢！

Answer 1

我认为您要做的是迭代标题并将下一行的值添加到字典中以生成JSON字符串。

看起来您正在使用VBA-JSON项目，但如果您不是以下解决方案需要此项目才能运行，请确保将此项目添加到您的项目中。您可以获得项目here的副本。此外，您必须添加对Microsoft Scripting Runtime的引用才能生效。

假设您有A1:C1中的标题和A2:C2 Sheet1中的数据，则以下内容应该有效。标题是键，下一行是值。

Option Explicit

Private Sub createJSON()
    Dim ws      As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1")
    Dim rng     As Range: Set rng = ws.Range("A1:C1")
    Dim cll     As Range
    Dim dict    As Dictionary: Set dict = New Dictionary
    Dim JSON    As String

    'Add the items to a dictionary
    For Each cll In rng
        If Not dict.exists(cll.Value) Then dict.Add cll.Value, cll.Offset(1, 0).Value
    Next

    JSON = JsonConverter.ConvertToJson(dict, Whitespace:=2)
    Debug.Print JSON
End Sub