/ VBA-JSON

Преобразование и анализ JSON для VBA (Windows и Mac Excel, Access и другие приложения Office). Он вырос из превосходного проекта vba-json с дополнениями и улучшениями, внесенными для устранения ошибок и повышения производительности (как часть of VBA-Web).

Протестировано в Windows Excel 2013 и Excel для Mac 2011, но должно применяться к 2007+.

• Для Windows- только поддержка, включите ссылку на “Microsoft Scripting Runtime”
• Для поддержки Mac и Windows включите VBA-Dictionary

Dim Json As ObjectSet Json = JsonConverter.ParseJson ("{" "a" ": 123," "b" ": [1,2  , 3,4], "" c "": {"" d "": 456}} ") 'Json (" a ") -> 123' Json (" b ") (2) -> 2 'Json (  "c") ("d") -> 456Json ("c") ("e") = 789Debug.Print JsonConverter.ConvertToJson (Json) '-> "{" a ": 123," b ": [1,  2,3,4], "c": {"d": 456, "e": 789}} "Debug.Print JsonConverter.ConvertToJson (Json, Whitespace: = 2) '->" {' "a":  123, '"b": [' 1, '2,' 3, '4'], '"c": {' "d": 456, '"e": 789'} '} "

 'Расширенный пример: чтение файла .json и загрузка в лист (только для Windows)' (добавить ссылку на Microsoft Scripting Runtime) '{"values": [{"a": 1, "b": 2, "  c ": 3}, ...]} Dim FSO как новый FileSystemObjectDim JsonTS как TextStreamDim JsonText как StringDim Parsed As Dictionary 'Прочитать .json fileSet JsonTS = FSO.OpenTextFile (" example.json ", ForReading) JsonText = JsonTS.ReadAllJsonTS.  Закройте 'Parse json to Dictionary' «значения» анализируются как Collection 'каждый элемент в «values» анализируется как DictionarySet Parsed = JsonConverter.ParseJson (JsonText)' Подготовить и записать значения в SheetDim Values ​​As VariantReDim Values ​​(Parsed («values»  ) .Count, 3) Dim Value As DictionaryDim i As Longi = 0 Для каждого значения в проанализированном ("values") Values ​​(i, 0) = Value ("a") Values ​​(i, 1) = Value ("b")  Values ​​(i, 2) = Value ("c") i = i + 1Next ValueSheets ("example"). Range (Cells (1, 1), Cells (Parsed ("values"). Count, 3)) = Values  

Параметры

VBA-JSON включает несколько параметров для настройки синтаксического анализа/преобразования при необходимости :

• UseDoubleForLargeNumbers (по умолчанию = False ) VBA хранит только 15 значащих цифр, поэтому любые числа больше чем они усечены. Это может привести к проблемам при использовании BIGINT (например, для идентификаторов или кредитных карт), поскольку они будут недопустимыми, если длина более 15 цифр. По умолчанию VBA-JSON будет использовать String для чисел длиной более 15 символов, которые содержат только цифры, используйте этот параметр, чтобы использовать Double вместо этого.
• AllowUnquotedKeys (по умолчанию = False ) Стандарт JSON требует, чтобы ключи объектов были заключены в кавычки ( " или '), используйте этот параметр, чтобы разрешить ключи без кавычек.
• EscapeSolidus (по умолчанию = False ) Экранирование солидуса (/) не требуется, используйте этот параметр, чтобы экранировать их как / в ConvertToJson .

 JsonConverter.JsonOptions.EscapeSolidus = True 

Установка

1. Загрузите последнюю версию
2. Импортируйте JsonConverter.bas в свой проект ( Откройте редактор VBA, Alt + F11 ; File> Import File)
3. Добавить Dictionary reference/class
   • Только для Windows: добавьте ссылку на «Microsoft Scripting Runtime».
   • Для Windows и Mac добавьте VBA-Dictionary

Ресурсы

• Обучающее видео (Красный степлер)

Разобрать строку в Excel Vba

У меня есть макрос, который отправляет XMLHTTP запрос к серверу, и он получает в качестве ответа строку обычного текста , а не строку формата JSON или другие стандартные форматы (по крайней мере, насколько мне известно).

Я хотел бы проанализировать выходную строку, чтобы получить доступ к данным в структурированном подходе таким же образом, как подпрограмма parseJson в этой ссылке

Моя проблема в Я плохо разбираюсь в регулярных выражениях и не могу изменить процедуру для своих нужд.

Строка, которую мне нужно проанализировать, имеет следующую структуру:

1. Строка представляет собой одну строку
2. Каждый отдельный параметр определяется своим именем параметра, равным символом, его значением и окончанием; “NID = 3;” или
3. Параметры могут быть собраны в “структурах”, запускаются и заканчиваться символом | и они идентифицируются своим именем, за которым следует; такие как
4. Структура может содержать также другие структуры

Пример выходной строки:

  | KC; | AD; PE = 5; PF = 3; | CD; PE = 5; HP = test;  | CD; PE = 3; HP = abc; |  

В этом случае есть макроструктура KC , которая содержит структуру AD . Структура AD состоит из параметров PE , PF и 2 структур CD . И, наконец, структуры CD имеют параметры PE и

Так что я бы хотел бы проанализировать строку для получения объекта/словаря , который отражает эту структуру, вы можете мне помочь?

Добавляет после первых ответов

Привет всем, спасибо за вашу помощь, но я думаю, что должен более четко указать результат, который я хотел бы получить. Для примера строки, который у меня есть, я хотел бы иметь объект со следующей структурой:

     5   3    5   тест     3   abc    

Итак, я начал писать возможную базу рабочего кода на некоторой подсказке из ответа @Nvj и ответа по этой ссылке

  Option ExplicitOption Base 1Sub Test () Dim strContent As String Dim strState As String Dim varOutput As Variant strContent = "| KC; | AD; PE = 5; PF = 3; | CD; PE  = 5; HP = test; | CD; PE = 3; HP = abc; | "  Вызов ParseString (strContent, varOutput, strState) End SubSub ParseString (ByVal strContent As String, varOutput As Variant, strState As String) 'strContent - source string' varOutput - созданный объект или массив, который должен быть возвращен как результат 'strState - Object | Array |  Ошибка в зависимости от обработки, которая должна быть возвращена как stateDim objTokens As ObjectDim lngTokenId As LongDim objRegEx As ObjectDim bMatched As BooleanSet objTokens = CreateObject ("Scripting.Dictionary") lngTokenId = 0Set objRegEx = CreateObject ("VRegloScript).  .MultiLine = True .IgnoreCase = True .Pattern = " | [AZ] {2};"  'Шаблон для имени структур Tokenize objTokens, objRegEx, strContent, lngTokenId, bMatched, "str" ​​.Pattern = "[A-Z] {2} = [^  | =;] +;"  'Шаблон для имени и значений параметров Tokenize objTokens, objRegEx, strContent, lngTokenId, bMatched, «par» End WithEnd SubSub Tokenize (objTokens, objRegEx, strContent, lngTokenId, bMatched, strType Asset String Asimd String Asimd StrKey) Dim strType String strKey  StringDim strPar As StringDim strVal As StringDim strLevel As StringDim strRes As StringDim lngCopyIndex As LongDim objMatch As ObjectstrRes = "" lngCopyIndex = 1With objRegEx Для каждого objMatch In .Execute IfMat (statchrType) = "StatchrContent"  (.Value, "|", "") strWork = Replace (strWork, ";", "") strLevel = get_Level (strWork) strKey = "" objTokens (strKey) =  strWork strRes = strRes & Mid (strContent, lngCopyIndex, .FirstIndex - lngCopyIndex + 1) & strKey lngCopyIndex = .FirstIndex + .Length + 1 Конец с lngTokenId = lngTokenId = "lngTokenId" = "lngTokenId + 1 Else.  & "par>" strKeyVal = " "strKey = strKeyPar & strKeyVal bMatched = True С objMatch strWork = Replace (.Value,"; "," ") strPar = Split (strWork," = ") (0) strVal = Split (strWork," = ")  (1) objTokens (strKeyPar) = strPar objTokens (strKeyVal) = strVal strRes = strRes & Mid (strContent, lngCopyIndex,. FirstIndex - lngCopyIndex + 1) & strKey lngCopyIndex = .FirstIndex + .Length + 1 Конец с lngTokenId = lngTokenId + 2 Конец, если следующий strContent = strRes & Mid (strContent, lngCopyIndevel), Len (strContent, lngCopyIndevel), Len (strContent, lngCopyIndevel) End_LengCopyIndetent, Len (strCopyIndetent) - End_LengCopyIndetent), Len (strEngCopyIndetent), Len (strEngCopyIndetent), Len (lngCopyIndetent), Len (strEngCopyIndetent), Len (str +  (strInput As String) As StringSelect Case strInput Case "KC" get_Level = "L1" Case "AD" get_Level = "L2" Case "CD" get_Level = "L3" Case Else MsgBox ("Error") EndEnd SelectEnd Function  

Эта функция создает словарь с элементом для каждого имени структуры, имени параметра и значения параметра, как показано на рисунке Благодаря функции get_Level элементы, связанные со структурами, имеют уровень, который должен помочь сохранить исходную иерархию данных.

Итак, мне не хватает функции для создания объекта с исходной структурой входной строки. Это то, что делает функция Retrieve в этой ответной ссылке, но я не знаю, как адаптировать ее к моему случаю

Я начал писать синтаксический анализатор на VBA для указанной вами строковой структуры, и он не завершен, но все равно выложу. Может быть, вы сможете почерпнуть из него какие-то идеи.

  Sub ParseString () Dim str As String str = "| KC; | AD; PE = 5; PF = 3; |  CD; PE = 5; HP = test; | CD; PE = 3; HP = abc; | "  'Объявить объектный словарь' Сделайте ссылку на Microsoft Scripting Runtime, чтобы это работало Dim dict As New Dictionary 'Если полосы присутствуют в первом и последнем символе строки, замените их str = Replace (str, "|  "," ", 1, 1) If (Mid (str, Len (str), 1) =" | ") Then str = Mid (str, 1, Len (str) - 1) End If 'Разделить строку на  bars Dim substring_array () As String substring_array = Split (str, "|") 'Объявить объект регулярного выражения' Проверьте ссылку на Microsoft VBScript Regular Expressions 5.5, чтобы это работало. Dim regex As New RegExp With regex .Global = True.  IgnoreCase = True .MultiLine = True End With 'Объект для хранения совпадений регулярного выражения Dim соответствует As MatchCollection Dim param_name_matches As MatchCollection Dim параметр_value_matches As MatchCollection' Определите некоторые шаблоны регулярных выражений pattern_for_structure_name = "^ [^ =;] +;"  pattern_for_parameters = "[^ =;] + = [^ =;] +;"  pattern_for_parameter_name = "[^ =;] =" pattern_for_parameter_val = "[^ =;];"  'Перебирать элементы массива Dim i As Integer For i = 0 To UBound (substring_array) - LBound (substring_array)' Получить элемент массива в строке str1 = substring_array (i) 'Проверить, содержит ли он регулярное выражение имени структуры.  Pattern = pattern_for_structure_name Установить совпадения = regex.Execute (str1) Если совпадет.Count = 0 Then 'Эта подстрока не содержит имя структуры' Проверить, содержит ли она параметры regex.Pattern = pattern_for_parameter Установить совпадения = regex. Execute (соответствует (0) .Value) Если соответствует.Count = 0 Then 'Нет параметров, а также нет имени структуры' Это означает, что строка имела ||  - недопустимая строка MsgBox ("Недопустимая строка") Else 'Строка содержит имена параметров' Добавить имя каждого параметра в словарь Dim my_match As match For Each my_match In match 'Получить имя параметра regex.Pattern = pattern_for_parameter_name Установить имя_параметра_matches = regex  .Execute (my_match.Value) 'Проверить, вернул ли приведенный выше какие-либо совпадения If parameter_name_matches.Count = 1 Then' Remove = sign from the parameter name parameter_name = Replace (parameter_name_matches (0) .Value, "=", "") 'Get  значение параметра regex.Pattern = pattern_for_parameter_value Установить параметр_value_matches = regex.Execute (my_match.Value) 'Проверить, вернул ли приведенный выше какие-либо совпадения If parameter_value_matches.Count = 1 Then' Получить значение parameter_value = Replace (parameter_value_matches (0) .Value (0) .Value  , ";", "") 'Добавьте имя параметра и значение в качестве пары ключей к объекту Dictionary dict.Item (имя_параметра) = значение_параметра Else' Число совпадений равно 0 или больше 1 - в обоих случаях  строка недействительна MsgBox ("Invalid string") End If Else 'Имя параметра не соответствует - недопустимая строка MsgBox ("Invalid string") End If Next End If ElseIf match.Count = 1 Then' Эта подстрока содержит одно имя структуры  'Проверьте, есть ли у него имена параметров Else' Эта подстрока содержит более одного имени структуры - исходная строка недействительна MsgBox ("Недопустимая строка") End If Next iEnd Sub  

  Option ExplicitFunction parseString (str As String) As Collection Dim a1 () As  String, i1 As Long, c1 As Collection Dim a2 () As String, i2 As Long, c2 As Collection Dim a3 () As String a1 = Split (str, "|") Set c1 = New Collection For i1 = LBound (a1  ) В UBound (a1) Если a1 (i1)  "" Затем установите c2 = New Collection a2 = Split (a1 (i1), ";") Для i2 = LBound (a2) В UBound (a2) Если a2 (i2  )  "" Тогда a3 = Split (a2 (i2), "=") Если UBound (a3)> 0 Тогда c2.Add a3 (1), a3 (0) ElseIf UBound (a3) ​​= 0 Тогда c2.Add  a3 (0) End If End If Next i2 c1.Add c2 End If Next i1 Установить parseString = c1End FunctionSub testParseString () Dim c As Collection Установить c = parseString ("| KC; | AD; PE = 5; PF = 3;  | CD; PE = 5; HP = test; | CD; PE = 3; HP = abc; | ") Debug.Assert c (1) (1) =" KC "Debug.Assert c (2) (" PE "  ) = "5" Debug.Assert c (3) (1) = "CD" Debug.Assert c (4) ("HP") = "abc" Отладка. Assert c (4) (3) = "abc" End Sub  

Это похоже на простую вложенную строку с разделителями. Подойдет пара функций Split () :

  Option ExplicitFunction parseString (str As String) As Collection Dim a1 () As  String, i1 As Long, c1 As Collection Dim a2 () As String, i2 As Long, c2 As Collection Dim a3 () As String a1 = Split (str, "|") Set c1 = New Collection For i1 = LBound (a1  ) В UBound (a1) Если a1 (i1)  "" Затем установите c2 = New Collection a2 = Split (a1 (i1), ";") Для i2 = LBound (a2) В UBound (a2) Если a2 (i2  )  "" Тогда a3 = Split (a2 (i2), "=") Если UBound (a3)> 0 Тогда c2.Add a3 (1), a3 (0) ElseIf UBound (a3) ​​= 0 Then c2.Add  a3 (0) End If End If Next i2 c1.Add c2 End If Next i1 Установить parseString = c1End FunctionSub testParseString () Dim c As Collection Установить c = parseString ("| KC; | AD; PE = 5; PF = 3;  | CD; PE = 5; HP = test; | CD; PE = 3; HP = abc; | ") Debug.Assert c (1) (1) =" KC "Debug.Assert c (2) (" PE "  ) = "5" Debug.Assert c (3) (1) = "CD" Debug.Assert c (4) ("HP") = "abc" Debug.Assert c (4) (3) = "abc" Конец  Sub  

Обратите внимание, что вы можете адресовать значения как по индексу, так и по ключу ( если ключ существовал на входе). Если ключ не был указан, вы можете получить доступ к значению только по его индексу. Вы также можете рекурсивно выполнять итерацию коллекции, чтобы получить все значения в древовидной структуре.

Пища для размышлений: поскольку ваши структуры могут иметь повторяющиеся имена (в вашем случае структура «CD» встречается дважды) Коллекции/Словари было бы проблематично хранить это элегантно (из-за конфликтов ключей). Еще один хороший способ приблизиться к этому – создать структуру XML с помощью DOMDocument и использовать XPath для доступа к ее элементам.. См. Программу с DOM в Visual Basic

ОБНОВЛЕНИЕ : я также добавил пример XML ниже. Взгляните.

  Функция parseStringToDom (str As String) As DOMDocument60 Dim a1 () As String, i1 As Long Dim a2  () Как String, i2 As Long Dim a3 () As String Dim dom As DOMDocument60 Dim rt As IXMLDOMNode Dim nd As IXMLDOMNode Set dom = New DOMDocument60 dom.async = False dom.validateOnParse = False dom.resolveExternals.Rese  True Установить rt = dom.createElement ("root") dom.appendChild rt a1 = Split (str, "|") For i1 = LBound (a1) To UBound (a1) If a1 (i1)  "" Тогда a2 =  Split (a1 (i1), ";") Set nd = dom.createElement (a2 (0)) For i2 = LBound (a2) To UBound (a2) If a2 (i2)  "" Тогда a3 = Split (a2  (i2), "=") Если UBound (a3)> 0 Then nd.appendChild dom.createElement (a3 (0)) nd.LastChild.Text = a3 (1) End If End If Next i2 rt.appendChild nd End If  Далее i1 Установить parseStringToDom = domEnd FunctionSub testParseStringToDom () Dim dom As DOMDocument60 Установить dom = parseStringToDom ("| KC; | AD; PE = 5; PF = 3; | CD; PE = 5; HP = test; | CD; PE =  3; HP =  abc; | ") Debug.Assert Not dom.SelectSingleNode ("/root/KC ") Нет ничего Debug.Assert dom.SelectSingleNode ("/root/AD/PE "). Text =" 5 "Debug.Assert dom.SelectSingleNode  ("/root/CD[1 visible/HP").Text =" test "Debug.Assert dom.SelectSingleNode ("/root/CD [2]/HP "). Text =" abc "Debug.Print dom.XMLEnd  Sub  

      5   3     5   тест     3   abc   

Вот еще один подход к проблеме синтаксического анализа строк с использованием парсера XML DOMDocument . Вам необходимо включить Microsoft XML, v.6.0 в свои ссылки VBA.

  Функция parseStringToDom (str As String) As DOMDocument60 Dim a1 () As String, i1 As Long Dim a2  () Как String, i2 As Long Dim a3 () As String Dim dom As DOMDocument60 Dim rt As IXMLDOMNode Dim nd As IXMLDOMNode Set dom = New DOMDocument60 dom.async = False dom.validateOnParse = False dom.resolveExternals.Rese  True Установить rt = dom.createElement ("root") dom.appendChild rt a1 = Split (str, "|") For i1 = LBound (a1) To UBound (a1) If a1 (i1)  "" Тогда a2 =  Split (a1 (i1), ";") Set nd = dom.createElement (a2 (0)) For i2 = LBound (a2) To UBound (a2) If a2 (i2)  "" Тогда a3 = Split (a2  (i2), "=") Если UBound (a3)> 0 Then nd.appendChild dom.createElement (a3 (0)) nd.LastChild.Text = a3 (1) End If End If Next i2 rt.appendChild nd End If  Далее i1 Установить parseStringToDom = domEnd FunctionSub testParseStringToDom () Dim dom As DOMDocument60 Установить dom = parseStringToDom ("| KC; | AD; PE = 5; PF = 3; | CD; PE = 5; HP = test; | CD; PE =  3; HP =  abc; | ") Debug.Assert Not dom.SelectSingleNode ("/root/KC ") Нет ничего Debug.Assert dom.SelectSingleNode ("/root/AD/PE "). Text =" 5 "Debug.Assert dom.SelectSingleNode  ("/root/CD[1 visible/HP").Text =" test "Debug.Assert dom.SelectSingleNode ("/root/CD [2]/HP "). Text =" abc "Debug.Print dom.XMLEnd  Sub  

Как видите, это преобразует ваш текст в документ XML DOM, сохраняя все структуры и позволяя дублировать имена. Затем вы можете использовать XPath для доступа к любому узлу или значению. Это также может быть расширено, чтобы иметь больше уровней вложенности и дополнительных структур.

Это XML-документ, который он создает за кулисами:

      5   3     5   тест     3   abc