' =====================================================
' JSON PARSER v4 - УМНЫЙ ПОИСК И ГРУППИРОВКА
' Версия: 4.0
' Дата: 2024
' Функционал: Поиск по ключам, группировка по родителям
' =====================================================

Sub UniversalJsonParser()
    On Error GoTo ErrorHandler
    
    Dim filePath As String, jsonContent As String
    Dim fileNum As Integer
    
    filePath = ThisWorkbook.Sheets(1).Range("ZV100").value
    If filePath = "" Then MsgBox "Сначала выберите файл!", vbExclamation: Exit Sub
    
    ' Чтение файла
    fileNum = FreeFile
    Open filePath For Input As #fileNum
    jsonContent = Input(LOF(fileNum), #fileNum)
    Close #fileNum
    
    ' Диалог выбора пути JSON
    Dim jsonPath As String
    jsonPath = InputBox("Введите путь к данным", "Путь JSON", "cards.cardMonthTurnovers")
    If jsonPath = "" Then Exit Sub
    
    ' Парсим JSON путь
    Dim pathParts() As String
    pathParts = Split(jsonPath, ".")
    
    ' Находим целевой массив
    Dim targetArray As String
    targetArray = FindJsonArrayByPath(jsonContent, pathParts)
    If targetArray = "" Then
        MsgBox "Массив не найден по пути: " & jsonPath, vbExclamation
        Exit Sub
    End If
    
    Debug.Print "Найденный массив: " & targetArray
    
    ' Извлекаем объекты из массива
    Dim objects() As String
    objects = ExtractObjectsFromArray(targetArray)
    
    If UBound(objects) < 0 Then
        MsgBox "Объекты не найдены в массиве!", vbExclamation
        Exit Sub
    End If
    
    Debug.Print "Найдено объектов: " & (UBound(objects) + 1)
    
    ' Автоматически определяем заголовки из первого объекта
    Dim headers() As String
    headers = ExtractKeysFromJsonObject(objects(0))
    Debug.Print "Заголовки: " & Join(headers, ", ")
    
    ' Создаем таблицу
    CreateTableWithHeaders headers, objects, jsonPath
    
    MsgBox "Выгружено " & (UBound(objects) + 1) & " записей", vbInformation
    Exit Sub
    
ErrorHandler:
    MsgBox "Ошибка: " & Err.Description, vbCritical
End Sub
Function ExtractObjectsFromArray(arrayText As String) As String()
    Dim objects() As String
    ReDim objects(0 To 0)
    Dim objCount As Long: objCount = -1
    Dim pos As Long: pos = 1
    Dim inString As Boolean: inString = False
    
    ' Убираем внешние скобки массива
    arrayText = Trim(arrayText)
    If Left(arrayText, 1) = "[" Then
        arrayText = Mid(arrayText, 2, Len(arrayText) - 2)
    End If
    
    ' ДИАГНОСТИКА
    Debug.Print "Анализируемый массив: " & arrayText
    
    ' Ищем объекты с учетом вложенности
    Do While pos <= Len(arrayText)
        If Mid(arrayText, pos, 1) = "{" And Not inString Then
            Dim objStart As Long, objEnd As Long
            objStart = pos
            objEnd = FindMatchingBracket(arrayText, objStart, "{", "}")
            
            If objEnd > objStart Then
                objCount = objCount + 1
                ReDim Preserve objects(0 To objCount)
                objects(objCount) = Mid(arrayText, objStart, objEnd - objStart + 1)
                Debug.Print "Найден объект " & objCount & ": " & Left(objects(objCount), 50)
                pos = objEnd + 1
            Else
                pos = pos + 1
            End If
        Else
            If Mid(arrayText, pos, 1) = """" Then inString = Not inString
            pos = pos + 1
        End If
    Loop
    
    ExtractObjectsFromArray = objects
End Function
Sub CreateTableWithHeaders(headers() As String, objects() As String, tableTitle As String)
    Dim ws As Worksheet
    Set ws = ThisWorkbook.ActiveSheet
    ws.Range("E3:Z100").ClearContents
    
    ' Заголовок таблицы
    ws.Cells(3, 5).value = tableTitle
    ws.Cells(3, 5).Font.Bold = True
    
    ' Заголовки колонок
    Dim col As Long
    For col = 0 To UBound(headers)
        With ws.Cells(4, 5 + col)
            .value = headers(col)
            .Font.Bold = True
            .Interior.Color = RGB(146, 208, 80)
        End With
    Next col
    
    ' Данные
     Dim row As Long, i As Long, j As Long
    For i = 0 To UBound(objects)
        Debug.Print "=== Обрабатываем объект " & i & " ==="
        Debug.Print "Полный объект: " & objects(i)
        
        For j = 0 To UBound(headers)
            Dim value As String
            value = ExtractValueFromObject(objects(i), headers(j))
            If value <> "" Then
                ws.Cells(5 + i, 5 + j).value = value
            End If
        Next j
    Next i
    
    ws.Columns("E:Z").AutoFit
End Sub
Function ExtractKeysFromJsonObject(objText As String) As String()
    Dim keys() As String
    ReDim keys(0 To 0)
    Dim keyCount As Long: keyCount = -1
    Dim pos As Long: pos = 1
    
    ' Упрощенный поиск ключей - ищем паттерн: "key":
    Do While pos > 0
        pos = InStr(pos, objText, """")
        If pos > 0 Then
            Dim quoteEnd As Long
            quoteEnd = InStr(pos + 1, objText, """")
            
            If quoteEnd > pos Then
                Dim potentialKey As String
                potentialKey = Mid(objText, pos + 1, quoteEnd - pos - 1)
                
                ' Проверяем что после ключа идет двоеточие
                Dim afterKey As Long
                afterKey = quoteEnd + 1
                Do While afterKey <= Len(objText) And (Mid(objText, afterKey, 1) = " " Or Mid(objText, afterKey, 1) = vbTab)
                    afterKey = afterKey + 1
                Loop
                
                If afterKey <= Len(objText) And Mid(objText, afterKey, 1) = ":" Then
                    ' Это настоящий ключ!
                    keyCount = keyCount + 1
                    ReDim Preserve keys(0 To keyCount)
                    keys(keyCount) = potentialKey
                End If
                
                pos = quoteEnd + 1
            Else
                pos = pos + 1
            End If
        End If
    Loop
    
    ExtractKeysFromJsonObject = keys
End Function
Function ExtractJsonBlock(jsonString As String, keyName As String) As String
    Dim startPos As Long, endPos As Long, braceCount As Long, i As Long
    
    startPos = InStr(1, jsonString, """" & keyName & """:")
    If startPos = 0 Then Exit Function
    
    startPos = startPos + Len(keyName) + 3
    Do While startPos <= Len(jsonString) And (Mid(jsonString, startPos, 1) = " " Or Mid(jsonString, startPos, 1) = """")
        startPos = startPos + 1
    Loop
    
    If startPos > Len(jsonString) Then Exit Function
    
    Dim firstChar As String
    firstChar = Mid(jsonString, startPos, 1)
    
    If firstChar = "{" Then
        braceCount = 1
        For i = startPos + 1 To Len(jsonString)
            If Mid(jsonString, i, 1) = "{" Then braceCount = braceCount + 1
            If Mid(jsonString, i, 1) = "}" Then braceCount = braceCount - 1
            If braceCount = 0 Then Exit For
        Next i
    ElseIf firstChar = "[" Then
        braceCount = 1
        For i = startPos + 1 To Len(jsonString)
            If Mid(jsonString, i, 1) = "[" Then braceCount = braceCount + 1
            If Mid(jsonString, i, 1) = "]" Then braceCount = braceCount - 1
            If braceCount = 0 Then Exit For
        Next i
    Else
        For i = startPos To Len(jsonString)
            If Mid(jsonString, i, 1) = "," Or Mid(jsonString, i, 1) = "}" Then Exit For
        Next i
    End If
    
    If i > Len(jsonString) Then Exit Function
    ExtractJsonBlock = Mid(jsonString, startPos, i - startPos + 1)
End Function
Function FindJsonArrayByPath(jsonContent As String, pathParts() As String) As String
    Dim currentContent As String
    currentContent = jsonContent
    Dim i As Long
    
    For i = 0 To UBound(pathParts)
        Dim block As String
        block = ExtractJsonBlock(currentContent, pathParts(i))
        If block = "" Then Exit Function
        currentContent = block
    Next i
    
    FindJsonArrayByPath = currentContent
End Function


Sub SmartJsonSearch()
    On Error GoTo ErrorHandler
    
    Dim filePath As String, jsonContent As String
    Dim fileNum As Integer
    
    filePath = ThisWorkbook.Sheets(1).Range("ZV100").value
    If filePath = "" Then MsgBox "Сначала выберите файл!", vbExclamation: Exit Sub
    
    ' Чтение файла
    fileNum = FreeFile
    Open filePath For Input As #fileNum
    jsonContent = Input(LOF(fileNum), #fileNum)
    Close #fileNum
    
    ' Диалог выбора режима
    Dim searchMode As String
    searchMode = InputBox("Выберите режим:" & vbCrLf & _
                         "1 - Полный путь (cards.cardMonthTurnovers)" & vbCrLf & _
                         "2 - Поиск по ключу (currency)", "Режим поиска", "2")
    
    If searchMode = "1" Then
        ' РЕЖИМ 1: Полный путь
        Dim jsonPath As String
        jsonPath = InputBox("Введите полный путь к данным", "Путь JSON", "cards.cardMonthTurnovers")
        If jsonPath = "" Then Exit Sub
        
        UniversalJsonParser ' Используем старую логику
        
    Else
        ' РЕЖИМ 2: Поиск по ключу
        Dim searchKey As String
        searchKey = InputBox("Введите ключ для поиска", "Поиск по ключу", "currency")
        If searchKey = "" Then Exit Sub
        
        FindAllValuesByKey jsonContent, searchKey
    End If
    
    Exit Sub
    
ErrorHandler:
    MsgBox "Ошибка: " & Err.Description, vbCritical
End Sub
Function ExtractValueFromObject(objText As String, fieldName As String) As String
    Dim fieldPos As Long, valueStart As Long, valueEnd As Long
    Dim char As String, inString As Boolean
    
    ' Ищем поле
    fieldPos = InStr(1, objText, """" & fieldName & """:")
    If fieldPos = 0 Then Exit Function
    
    ' Находим начало значения (после двоеточия)
    valueStart = fieldPos + Len(fieldName) + 3 ' +3 для ":"
    
    ' Пропускаем пробелы ДО значения
    Do While valueStart <= Len(objText)
        char = Mid(objText, valueStart, 1)
        If char <> " " Then Exit Do
        valueStart = valueStart + 1
    Loop
    
    If valueStart > Len(objText) Then Exit Function
    
    ' ОПРЕДЕЛЯЕМ КОНЕЦ ЗНАЧЕНИЯ
    valueEnd = valueStart
    inString = False
    
    ' Смотрим на первый символ значения
    char = Mid(objText, valueStart, 1)
    
    If char = """" Then
        ' ЗНАЧЕНИЕ - СТРОКА (в кавычках)
        valueStart = valueStart + 1 ' Пропускаем открывающую кавычку
        valueEnd = valueStart
        
        ' Ищем ЗАКРЫВАЮЩУЮ кавычку для ЭТОГО значения
        Do While valueEnd <= Len(objText)
            char = Mid(objText, valueEnd, 1)
            
            If char = """" Then
                ' Проверяем что это не экранированная кавычка
                If valueEnd > 1 Then
                    If Mid(objText, valueEnd - 1, 1) <> "\" Then
                        Exit Do ' Нашли закрывающую кавычку
                    End If
                Else
                    Exit Do ' Нашли закрывающую кавычку
                End If
            End If
            
            valueEnd = valueEnd + 1
        Loop
        
    Else
        ' ЗНАЧЕНИЕ - ЧИСЛО, BOOLEAN, NULL
        Do While valueEnd <= Len(objText)
            char = Mid(objText, valueEnd, 1)
            
            ' Выходим при запятой или закрывающей скобке
            If char = "," Or char = "}" Then Exit Do
            
            valueEnd = valueEnd + 1
        Loop
    End If
    
    ' ИЗВЛЕКАЕМ ТОЛЬКО ЗНАЧЕНИЕ
    If valueEnd > valueStart Then
        ExtractValueFromObject = Trim(Mid(objText, valueStart, valueEnd - valueStart))
        Debug.Print "УСПЕШНО извлекли '" & fieldName & "': '" & ExtractValueFromObject & "'"
    End If
End Function
Sub FindAllValuesByKey(jsonContent As String, searchKey As String)
    Dim ws As Worksheet
    Set ws = ThisWorkbook.ActiveSheet
    ws.Range("E3:Z100").ClearContents
    
    ' Заголовки
    ws.Cells(3, 5).value = "Родительский путь"
    ws.Cells(3, 6).value = searchKey
    ws.Range("E3:F3").Font.Bold = True
    ws.Range("E3:F3").Interior.Color = RGB(146, 208, 80)
    
    Dim row As Long: row = 4
    Dim count As Long: count = 0
    
    ' ПРОСТОЙ И ТОЧНЫЙ ПОИСК
    Dim pos As Long: pos = 1
    Do While pos > 0
        pos = InStr(pos, jsonContent, """" & searchKey & """:")
        If pos > 0 Then
            ' Извлекаем значение ПРАВИЛЬНО
            Dim value As String
            value = ExtractValueSimple(jsonContent, pos + Len(searchKey) + 2)
            
            If value <> "" Then
                ' Находим родительский путь ПРАВИЛЬНО
                Dim parentPath As String
                parentPath = FindParentPathSimple(jsonContent, pos)
                
                ' Записываем результат
                ws.Cells(row, 5).value = parentPath
                ws.Cells(row, 6).value = value
                row = row + 1
                count = count + 1
            End If
            
            pos = pos + Len(searchKey) + 3
        End If
    Loop
    
    If count = 0 Then
        MsgBox "Ключ '" & searchKey & "' не найден в JSON", vbInformation
    Else
        ws.Columns("E:F").AutoFit
        MsgBox "Найдено " & count & " значений для ключа '" & searchKey & "'", vbInformation
    End If
End Sub
Function ExtractValueSimple(jsonContent As String, startPos As Long) As String
    Dim valueStart As Long: valueStart = startPos
    Dim valueEnd As Long: valueEnd = startPos
    
    ' Пропускаем пробелы и двоеточия
    Do While valueStart <= Len(jsonContent)
        Dim char As String
        char = Mid(jsonContent, valueStart, 1)
        If char <> " " And char <> ":" Then Exit Do
        valueStart = valueStart + 1
    Loop
    
    If valueStart > Len(jsonContent) Then Exit Function
    
    ' Определяем тип значения
    char = Mid(jsonContent, valueStart, 1)
    
    If char = """" Then
        ' СТРОКА - извлекаем между кавычками
        valueStart = valueStart + 1
        valueEnd = InStr(valueStart, jsonContent, """")
        If valueEnd = 0 Then Exit Function
    Else
        ' ЧИСЛО или BOOLEAN - ищем до запятой или }
        valueEnd = valueStart
        Do While valueEnd <= Len(jsonContent)
            char = Mid(jsonContent, valueEnd, 1)
            If char = "," Or char = "}" Then Exit Do
            valueEnd = valueEnd + 1
        Loop
    End If
    
    If valueEnd > valueStart Then
        ExtractValueSimple = Trim(Mid(jsonContent, valueStart, valueEnd - valueStart))
    End If
End Function

Function FindParentPathSimple(jsonContent As String, keyPos As Long) As String
    ' Простой поиск ближайших структурных ключей
    Dim path As String
    
    ' Ищем "cards" перед ключом
    Dim cardsPos As Long
    cardsPos = InStrRev(jsonContent, """cards"":", keyPos)
    If cardsPos > 0 Then
        path = "cards"
    End If
    
    ' Ищем "cardMonthTurnovers" перед ключом
    Dim turnoversPos As Long
    turnoversPos = InStrRev(jsonContent, """cardMonthTurnovers"":", keyPos)
    If turnoversPos > 0 Then
        If path <> "" Then path = path & "."
        path = path & "cardMonthTurnovers"
    End If
    
    ' Ищем "Tenders" перед ключом
    Dim tendersPos As Long
    tendersPos = InStrRev(jsonContent, """Tenders"":", keyPos)
    If tendersPos > 0 Then
        If path <> "" Then path = path & "."
        path = path & "Tenders"
    End If
    
    FindParentPathSimple = path
End Function
Function FindParentPath(jsonContent As String, keyPos As Long) As String
    Dim path As String
    Dim currentPos As Long: currentPos = keyPos
    
    ' Ищем все родительские объекты
    Do While currentPos > 0
        Dim objStart As Long
        objStart = FindObjectStart(jsonContent, currentPos)
        
        If objStart > 0 Then
            Dim keyName As String
            keyName = FindKeyBeforeObject(jsonContent, objStart)
            
            If keyName <> "" Then
                If path <> "" Then path = "." & path
                path = keyName & path
                
                ' Пропускаем служебные ключи
                If keyName = "cards" Or keyName = "Tenders" Or keyName = "cardMonthTurnovers" Then
                    ' Это нужные нам ключи - продолжаем
                Else
                    ' Это значения, а не ключи - останавливаемся
                    Exit Do
                End If
            End If
            
            currentPos = objStart - 1
        Else
            Exit Do
        End If
    Loop
    
    FindParentPath = path
End Function

Function FindObjectStart(jsonContent As String, position As Long) As Long
    ' Ищем начало объекта, содержащего данную позицию
    Dim pos As Long: pos = position - 1
    Dim braceCount As Long: braceCount = 0
    
    Do While pos > 0
        If Mid(jsonContent, pos, 1) = "}" Then
            braceCount = braceCount + 1
        ElseIf Mid(jsonContent, pos, 1) = "{" Then
            If braceCount = 0 Then
                FindObjectStart = pos
                Exit Function
            Else
                braceCount = braceCount - 1
            End If
        End If
        pos = pos - 1
    Loop
    
    FindObjectStart = 0
End Function


Function FindMatchingBracket(text As String, startPos As Long, openChar As String, closeChar As String) As Long
    Dim count As Long: count = 1
    Dim i As Long: i = startPos + 1
    Dim inString As Boolean: inString = False
    
    Do While i <= Len(text) And count > 0
        Dim currentChar As String
        currentChar = Mid(text, i, 1)
        
        If currentChar = """" Then inString = Not inString
        
        If Not inString Then
            If currentChar = openChar Then count = count + 1
            If currentChar = closeChar Then count = count - 1
        End If
        
        i = i + 1
    Loop
    
    If count = 0 Then FindMatchingBracket = i - 1 Else FindMatchingBracket = 0
End Function

Function FindKeyBeforeObject(jsonContent As String, objPos As Long) As String
    ' Ищем ключ непосредственно перед объектом
    Dim pos As Long: pos = objPos - 1
    Dim inString As Boolean: inString = False
    Dim quoteCount As Long: quoteCount = 0
    Dim keyStart As Long, keyEnd As Long
    
    ' Ищем назад до двоеточия (начало ключа)
    Do While pos > 0
        Dim char As String
        char = Mid(jsonContent, pos, 1)
        
        If char = """" Then
            inString = Not inString
            If Not inString Then
                quoteCount = quoteCount + 1
                If quoteCount = 1 Then
                    keyEnd = pos - 1 ' Конец ключа
                ElseIf quoteCount = 2 Then
                    keyStart = pos + 1 ' Начало ключа
                    Exit Do
                End If
            End If
        ElseIf char = ":" And Not inString Then
            ' Нашли двоеточие - ключ должен быть перед ним
            Exit Do
        End If
        
        pos = pos - 1
    Loop
    
    If keyStart > 0 And keyEnd >= keyStart Then
        FindKeyBeforeObject = Mid(jsonContent, keyStart, keyEnd - keyStart + 1)
    Else
        FindKeyBeforeObject = ""
    End If
End Function
Function FindParentKeyName(jsonContent As String, objPos As Long) As String
    ' Ищем ключ, который предшествует этому объекту
    Dim pos As Long: pos = objPos - 1
    Dim quoteCount As Long: quoteCount = 0
    Dim keyStart As Long, keyEnd As Long
    
    ' Ищем назад до открывающей кавычки ключа
    Do While pos > 0
        If Mid(jsonContent, pos, 1) = """" Then
            quoteCount = quoteCount + 1
            If quoteCount = 2 Then
                keyEnd = pos - 1
                Exit Do
            ElseIf quoteCount = 1 Then
                keyStart = pos
            End If
        End If
        pos = pos - 1
    Loop
    
    If keyStart > 0 And keyEnd > keyStart Then
        FindParentKeyName = Mid(jsonContent, keyStart + 1, keyEnd - keyStart)
    Else
        FindParentKeyName = "object"
    End If
End Function

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