Выбрать дату в календареВыбрать дату в календаре

Страницы: 1
VBA парсинг JSON - различные модификации, Различные примеры применения готовой библиотеки и своих наработок
 
Итак - чуть позже оформлю   типовые готовые json-ы    и типовое использование для обработки данных  
а пока первый пример -  использование библиотеки VBA-JSON-2.3.1  
выбор json определяется отдельным макросом, который запишет в определённую ячейку сетевой путь файла json , который будет использовать для парсинга - без хранения самого json-а  в экселе
Код
Sub SelectJsonFile()
    Dim filePath As Variant
    filePath = Application.GetOpenFilename("JSON Files (*.json), *.json", , "Выберите JSON файл")
    If filePath = False Then Exit Sub
    
    ThisWorkbook.Sheets(1).Range("ZV100").Value = filePath
    MsgBox "Файл выбран:" & vbCrLf & filePath, vbInformation
End Sub


Sub Extractor()

Dim filePath As String, jsonContent As String
Dim Json As Object
    filePath = ThisWorkbook.Sheets(1).Range("ZV100").Value



    fileNum = FreeFile
    Open filePath For Input As #fileNum
    fileContent = Input(LOF(fileNum), #fileNum)
    Close #fileNum
    
    
    If filePath = "" Then MsgBox "Сначала выберите файл!", vbExclamation: Exit Sub
    
    jsonContent = fileContent
    MsgBox (fileContent)
    'ReadFile (filePath)
    Set Json = JsonConverter.ParseJson(jsonContent)
    MsgBox Json("birthDate")
   MsgBox Json("cards")(1)("cardMonthTurnovers")(1)("currency")
End Sub



Option Explicit

Sub ExtractCardData()

    Dim filePath As String, jsonContent As String
    Dim Json As Object
    Dim cards As Object ' Collection
    Dim card As Object ' Dictionary
    Dim cardMonthTurnovers As Object ' Collection
    Dim turnover As Object ' Dictionary
    Dim ws As Worksheet
    Dim row As Long
    Dim col As Long
    Dim key As Variant ' Для итерации по ключам словаря

    ' --- 1. Получение пути к файлу и чтение JSON ---
    filePath = ThisWorkbook.Sheets(1).Range("ZV100").Value

    fileNum = FreeFile
    Open filePath For Input As #fileNum
    jsonContent = Input(LOF(fileNum), #fileNum)
    Close #fileNum

    If filePath = "" Then MsgBox "Сначала выберите файл!", vbExclamation: Exit Sub

    ' --- 2. Парсинг JSON ---
    Set Json = JsonConverter.ParseJson(jsonContent)

    ' --- 3. Инициализация ---
    Set ws = ThisWorkbook.ActiveSheet
    row = 5 ' Начинаем с ячейки A5
    col = 1 ' Начинаем с колонки A

    ' --- 4. Получение массива cards ---
    Set cards = Json("cards")

    ' --- 5. Обход массива cards ---
    Dim i As Long, j As Long
    For i = 1 To cards.Count ' Перебираем все элементы массива cards (коллекция)
        Set card = cards(i)

        ' Получаем массив cardMonthTurnovers
        Set cardMonthTurnovers = card("cardMonthTurnovers")

        ' Обход массива cardMonthTurnovers
        For j = 1 To cardMonthTurnovers.Count
            Set turnover = cardMonthTurnovers(j)

            ' --- Запись данных в Excel ---

            ' Запись lvl1 (cards)
            ws.Cells(row, col).Value = "cards"

            ' Запись lvl2 (cardMonthTurnovers)
            ws.Cells(row, col + 1).Value = "cardMonthTurnovers"

            ' Запись lvl3 (значение не нужно)
            ws.Cells(row, col + 2).Value = "" ' Пусто, так как нет имени уровня

            ' Запись полей из turnover
            Dim headerRow As Long
            headerRow = 4 ' Строка для заголовков столбцов

            Dim currentCol As Long
            currentCol = col + 3 ' Начинаем с 4-го столбца (A, B, C, D)

            ' Записываем значения из turnover
            For Each key In turnover.Keys

                ' Проверяем, существует ли уже столбец с таким заголовком
                Dim headerFound As Boolean
                headerFound = False
                Dim k As Long
                For k = col + 3 To currentCol
                    If ws.Cells(headerRow, k).Value = key Then
                        headerFound = True
                        currentCol = k
                        Exit For
                    End If
                Next k

                ' Если столбца нет, создаем новый
                If Not headerFound Then
                    ws.Cells(headerRow, currentCol).Value = key ' Заголовок столбца
                End If

                ' Записываем значение
                ws.Cells(row, currentCol).Value = turnover(key)

                currentCol = currentCol + 1 ' Переходим к следующему столбцу
            Next key

            row = row + 1 ' Переходим к следующей строке
        Next j

    Next i

    ' --- Автоматическая ширина столбцов ---
    ws.Columns.AutoFit

    MsgBox "Данные успешно выгружены.", vbInformation

    ' --- Очистка объектов ---
    Set Json = Nothing
    Set cards = Nothing
    Set card = Nothing
    Set cardMonthTurnovers = Nothing
    Set turnover = Nothing
    Set ws = Nothing

End Sub
Изменено: Grolmag - 10.09.2025 14:51:10
Страницы: 1
Наверх