Конвертировать ячейки Excel в JSON, используя VBA

Question

Я пытаюсь преобразовать ячейки Excel в JSON данные, но не могу реализовать правильные логи c.

Данные Excel выглядят следующим образом

и ожидаемый результат выглядит следующим образом

    {
    'pr1' : [   { 'hw' : ['LC', 'Repl']},
            { 'web' : ['LC', 'Repl']}
    ]
   }

Я написал код ниже, но он не работает должным образом.

    For i = 1 To 546
    If pro <> Cells(i, 1).Value Then
        oFile.writeline ""
        oFile.write '" + Cells(i, 1).Value + " ':{ '" + Cells(i, 2).Value + "' : ' " + Cells(i, 3).Value + "', "

    Else
        If pro = Cells(i, 1).Value Then
            If opt1 <> Cells(i, 2).Value Then
                oFile.writeline " , '" + Cells(i, 2).Value + "' : " + ",'" + Cells(i, 3).Value + "'"
            Else

                oFile.write '" + Cells(i, 3).Value + " ', "

                oFile.write ""

            End If
            oFile.write " "
        End If
        oFile.write " "
    End If
    If pro = Cells(i + 1, 1).Value And opt1 <> Cells(i + 1, 2).Value Then
        oFile.write " } "
    End If

    If pro <> Cells(i + 1, 1).Value And opt1 <> Cells(i + 1, 2).Value Then
        oFile.write "  "
    End If

    pro = Cells(i, 1).Value
    opt1 = Cells(i, 2).Value
    opt2 = Cells(i, 3).Value
    Next i

Answer 1

использовать Dictionary объект для хранения:

• уникальный столбец A в качестве ключей и новый словарь в качестве их элемента

• для каждого ключ, элемент словаря будет хранить значения столбца B в качестве уникальных ключей и комбинацию всех значений столбца C в качестве элемента

следующим образом:

Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")

Dim key As Variant, key2 As Variant
Dim cel As Range
With Worksheets("MySheetName") ' change "MySheetName" to your actual sheet name
    For Each cel In .Range("A1", .Cells(.Rows.Count, 1).End(xlUp)).SpecialCells(xlCellTypeConstants)
        key = cel.Value: key2 = cel.Offset(, 1).Value
        If Not dict.exists(key) Then dict.Add key, CreateObject("Scripting.Dictionary")
        dict(key).Item(key2) = dict(key).Item(key2) & "'" & cel.Offset(, 2).Value & "',"
    Next
End With


' build the JSON string for each key (i.e. only "pr1" in your example)
Dim s As String
For Each key In dict.keys
    s = String(4, " ") & "{" & vbCrLf & String(4, " ") & "'" & key & "' : [   "
    For Each key2 In dict(key)
        s = s & "{ '" & key2 & "' : [" & Left(dict(key)(key2), Len(dict(key)(key2)) - 1) & "]}," & vbCrLf & String(12, " ")
    Next
    s = Left$(s, Len(s) - 15) & vbCrLf & String(4, " ") & "]" & vbCrLf & String(3, " ") & "}"
    Debug.Print s
Next