Конвертировать Excel лист (вложенный) в JSON

Question

Я даю таблицу, и мне нужно конвертировать в JSON. У меня есть следующая электронная таблица:

По сути, мне нужно преобразовать в такой код:

{ "CompanyA": {
    "Products": ["Beds", "Knifes", "Spoons"]
}, "CompanyB": {
    "Products": ["Beds", "Knifes", "Spoons"],
    "Sites": ["West Coast", "East Coast"]
}, "CompanyC": {
    "Office": ["Los Angeles"]
}}

Я пытался просмотреть онлайн-источники, но у меня нет хорошего решения для того, что я ищу

Answer 1

Sub ConvertToJSONText()
    Dim Sht As Worksheet
    Set Sht = Worksheets("Sheet1")
    Dim a As Integer
    Dim lstA
    Dim lstB
    Dim lstC
    a = 0
    Dim myJsonText
    myJsonText = "{"
    Do While True
       a = a + 1
       If Sht.Range("a" & a).Value = "" And Sht.Range("b" & a).Value = "" And Sht.Range("c" & a).Value = "" Then
          Exit Do
       End If
       If Sht.Range("a" & a).Value <> "" And Sht.Range("b" & a).Value = "" And Sht.Range("c" & a).Value = "" Then
          If lstB <> "" Then myJsonText = myJsonText & "]"
          If lstA <> "" Then myJsonText = myJsonText & "},"
      lstA = Sht.Range("a" & a).Value
          lstB = ""
          lstC = ""
          myJsonText = myJsonText & """" & lstA & """: {"
       End If
       If Sht.Range("a" & a).Value = "" And Sht.Range("b" & a).Value <> "" And Sht.Range("c" & a).Value = "" Then
          If lstB <> "" Then myJsonText = myJsonText & "]"
          lstB = Sht.Range("B" & a).Value
          lstC = ""
          myJsonText = myJsonText & """" & lstB & """: ["
       End If
       If Sht.Range("a" & a).Value = "" And Sht.Range("b" & a).Value = "" And Sht.Range("c" & a).Value <> "" Then
          If lstC <> "" Then myJsonText = myJsonText & ","
          lstC = Sht.Range("C" & a).Value
          myJsonText = myJsonText & """" & lstC & """"
       End If
    Loop
    If lstB <> "" Then myJsonText = myJsonText & "]"
    myJsonText = myJsonText & "}"
End Sub

Answer 2

Вот некоторый базовый код, который должен указывать вам правильное направление.

Я прокомментировал это как можно больше.

Sub GetJSONOutput()
Dim wks As Worksheet: Set wks = ActiveSheet
Dim lngLastRow As Long, i As Long, j As Long, k As Long
Dim blFirstRow As Boolean
Dim strOut As String
lngLastRow = wks.Cells.Find("*", wks.Cells(1, 1), , , , xlPrevious).Row
k = 1
For i = 1 To lngLastRow
    '\\ First Element - Column A
    '\\ Check for first line and build beginning style
    If Len(wks.Cells(i, 1).Value) > 0 Then
        If blFirstRow = False Then
            strOut = "{ """ & wks.Cells(i, 1).Value & """: {"
            blFirstRow = True
        Else '\\ Rest follow the same style
            strOut = "}, """ & wks.Cells(i, 1).Value & """: {"
        End If
        wks.Cells(k, 4).Value = strOut: k = k + 1 '--> Output Column D
    End If

    '\\ Middle element - Column B
    If Len(wks.Cells(i, 2).Value) > 0 Then strbase = "    """ & wks.Cells(i, 2).Value & """: ["

    If Len(wks.Cells(i, 3).Value) > 0 Then
        '\\ Now we have Middle element then we need to loop through all elements under it!
        '\\ Last Element - Column C
        If Len(wks.Cells(i + 1, 3).Value) > 0 Then
            strAppend = ""
            For j = i To wks.Cells(i, 3).End(xlDown).Row
                strAppend = strAppend & "|" & wks.Cells(j, 3).Value
            Next j
            strOut = strbase & """" & Replace(Mid(strAppend, 2, Len(strAppend)), "|", Chr(34) & ", " & Chr(34)) & """]"
            wks.Cells(k, 4).Value = strOut: k = k + 1  '--> Output Column D
            i = j - 1
        Else
            strOut = strbase & """" & wks.Cells(i, 3).Value & """]"
            wks.Cells(k, 4).Value = strOut: k = k + 1  '--> Output Column D
        End If
    End If
    '\\ Complete output by outputting the last closing brackets
    If i = lngLastRow Then
        strOut = "}}"
        wks.Cells(k, 4).Value = strOut  '--> Output Column D
    End If
Next i
End Sub