Решение есть!
Я написал скрипт на встроенном языке Excel - Microsoft Visual Basic, который превращает Excel-таблицы в JSON-файлы одной командой. Больше никаких ошибок при копировании, потери данных или бесконечного форматирования.
⚡Особенности:
Автоматическое определение типов данных❗
Обработка всех видимых листов ❗
Экранирование кавычек в тексте ❗
Поддержка дат и булевых значений ❗
Игнорирование пустых строк и листов ❗
Как это работает?
1️⃣ Заполняете таблицы в книге Excel соблюдая простые правила
Структура файла:
Каждый лист = массив JSON-объектов.
Первая строка листа = заголовки (ключи JSON).
Каждая последующая строка = объект.
2️⃣ Запускаете скрипт.
3️⃣ Готовый JSON у вас в папке.
Инструкция:
- Подготовка Excel:
Создайте листы с данными (пример: "Лист1", "город").
Заголовки столбцов = ключи JSON.
Заполните данные, начиная со строки 2. - Добавление макроса:
ALT + F11 → правый клик на VBAProject → Insert → Module.
Вставьте код → ❗сохраните файл как .xlsm. ( Книга Excel с поддержкой макросов)
Запуск конвертации:
Нажмите ALT + F8 → выберите ExportToJSON → Run.
JSON будет сохранен в папке с файлом Excel.
Код для модуля на VBA
'// === Excel to JSON Export Module ===
Option Explicit
'// Main export procedure
Sub ExportToJSON()
On Error GoTo ErrorHandler
Dim dictData As Object
Dim stream As Object
Dim jsonStr As String
Dim filePath As String
' Initialize data dictionary
Set dictData = CreateObject("Scripting.Dictionary")
' Process visible worksheets
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
If ws.Visible = xlSheetVisible Then
If Not ws.Range("A1").CurrentRegion Is Nothing Then
dictData.Add ws.Name, ProcessWorksheet(ws)
End If
End If
Next ws
' Generate JSON
jsonStr = GenerateJSON(dictData)
' Save to file
'// filePath = ThisWorkbook.Path & "\export.json"
If ThisWorkbook.Path <> "" Then
filePath = ThisWorkbook.Path
MsgBox "Путь к файлу" & filePath, vbInformation
Else
MsgBox "Файл ещё не сохранён", vbExclamation
End If
filePath = filePath & "\export.json"
Set stream = CreateUTF8Stream()
stream.WriteText jsonStr
stream.SaveToFile filePath, 2
stream.Close
MsgBox "JSON успешно сохранён в: " & vbNewLine & filePath, vbInformation
Exit Sub
ErrorHandler:
MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical
End Sub
'// Process worksheet data
Private Function ProcessWorksheet(ws As Worksheet) As Object
Dim dataRange As Range
Dim headers As Variant
Dim dataArr As Variant
Dim result As Collection
Dim i As Long, j As Long
Set result = New Collection
With ws
Set dataRange = .Range("A1").CurrentRegion
headers = dataRange.Rows(1).value
dataArr = dataRange.Offset(1).Resize(dataRange.Rows.Count - 1).value
End With
For i = 1 To UBound(dataArr, 1)
Dim rowDict As Object
Set rowDict = CreateObject("Scripting.Dictionary")
rowDict.Add headers(1, j), ParseValue(dataArr(i, j))
End If
Next j
result.Add rowDict
Next i
Set ProcessWorksheet = result
End Function
'// Value type parser
Private Function ParseValue(value As Variant) As String
Select Case True
Case IsNumeric(value):
ParseValue = CStr(value)
Case IsDate(value):
ParseValue = """" & Format(value, "yyyy-mm-dd") & """"
Case LCase(value) = "true" Or LCase(value) = "false":
ParseValue = LCase(value)
Case Else:
ParseValue = """" & Replace(value, """", "\""") & """"
End Select
End Function
'// JSON generator
Private Function GenerateJSON(data As Object) As String
Dim key As Variant
Dim jsonOutput As String
jsonOutput = "{"
For Each key In data.KeysjsonOutput = jsonOutput & """" & key & """: ["
Dim item As Object
For Each item In data(key)
jsonOutput = jsonOutput & "{"
Dim prop As Variant
For Each prop In item.Keys
jsonOutput = jsonOutput & """" & prop & """:" & item(prop) & ","
Next prop
If Right(jsonOutput, 1) = "," Then jsonOutput = Left(jsonOutput, Len(jsonOutput) - 1)
jsonOutput = jsonOutput & "},"
Next item
If Right(jsonOutput, 1) = "," Then jsonOutput = Left(jsonOutput, Len(jsonOutput) - 1)
jsonOutput = jsonOutput & "],"
Next key
If Right(jsonOutput, 1) = "," Then jsonOutput = Left(jsonOutput, Len(jsonOutput) - 1)
GenerateJSON = jsonOutput & "}"
End Function
'// UTF-8 stream creator
Private Function CreateUTF8Stream() As Object
On Error GoTo StreamError
Set CreateUTF8Stream = CreateObject("ADODB.Stream")
With CreateUTF8Stream
.Type = 2
.Charset = "utf-8"
.Open
End With
Exit Function
StreamError:
MsgBox "Error creating stream: " & Err.Description, vbCritical
Set CreateUTF8Stream = Nothing
End Function
Почему это круто?
• Работает с вложенными структурами
• Сохраняет типы данных (даты, числа, строки)
• Настраивается под любые разделители
Теги:
#Excel JSON #АвтоматизацияДанных
#Конвертор
#АналитикаДанных
#ОбучениеExcel
Если скрипт сэкономил вам время:
Можете поддержать меня комментарием или ☕. Ваша благодарность вдохновляет на новые проекты!
P.S. А вы чаще работаете с Excel или JSON? Делитесь в комментариях — обсудим боли и лайфхаки!