将excelinput转换成json

我想在Excel中提取一个带有以下input的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

我想你想要做的是遍历头，并将下一行的值添加到字典中以生成JSONstring。

看起来你正在使用VBA-JSON项目，但如果你不是下面的解决scheme需要这个项目的function，所以请确保将其添加到您的项目。 你可以在这里得到一个项目的副本。 此外，您必须添加对Microsoft Scripting Runtime的引用才能使其工作。

假设你有A1:C1标题和Sheet1中A2:C2中的数据，下面的代码应该可以工作。 标题是键 ，下一行是值 。

 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