Итак - чуть позже оформлю типовые готовые 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