2016-11-27 4 views
2

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

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

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

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

  1. Строка представляет собой одну строку
  2. Каждый отдельный параметр определяется его параметром имя равное Simbol, его значение и заканчивая; "NID = 3;" или «SID = Test;»
  3. Параметр может быть собран в «структурах» начинается и заканчивается символом | и они идентифицируются с их именем, за которым следует; таких как | STEST; NID = 3; SID = Test; |
  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 и HP

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

добавляет после того, как первые ответы

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

<KC> 
    <AD> 
     <PE>5</PE> 
     <PF>3</PF> 
     <CD> 
      <PE>5</PE> 
      <HP>test</HP> 
     </CD> 
     <CD> 
      <PE>3</PE> 
      <HP>abc</HP> 
     </CD> 
    </AD> 
</KC> 

Так что я начал написал возможную рабочую базу коды на каком-то намеке от @Nvj ответа и ответ на этом link

Option Explicit 
Option Base 1 

Sub 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;|" 
    Call ParseString(strContent, varOutput, strState) 

End Sub 

Sub ParseString(ByVal strContent As String, varOutput As Variant, strState As String) 
' strContent - source string 
' varOutput - created object or array to be returned as result 
' strState - Object|Array|Error depending on processing to be returned as state 
Dim objTokens As Object 
Dim lngTokenId As Long 
Dim objRegEx As Object 
Dim bMatched As Boolean 

Set objTokens = CreateObject("Scripting.Dictionary") 
lngTokenId = 0 
Set objRegEx = CreateObject("VBScript.RegExp") 
With objRegEx 
    .Global = True 
    .MultiLine = True 
    .IgnoreCase = True 
    .Pattern = "\|[A-Z]{2};" 'Pattern for the name of structures 
    Tokenize objTokens, objRegEx, strContent, lngTokenId, bMatched, "str" 
    .Pattern = "[A-Z]{2}=[^\|=;]+;" 'Pattern for parameters name and values 
    Tokenize objTokens, objRegEx, strContent, lngTokenId, bMatched, "par" 
End With 

End Sub 

Sub Tokenize(objTokens, objRegEx, strContent, lngTokenId, bMatched, strType) 
Dim strKey  As String 
Dim strKeyPar  As String 
Dim strKeyVal  As String 

Dim strWork  As String 
Dim strPar  As String 
Dim strVal  As String 
Dim strLevel  As String 

Dim strRes  As String 

Dim lngCopyIndex As Long 
Dim objMatch  As Object 

strRes = "" 
lngCopyIndex = 1 
With objRegEx 
    For Each objMatch In .Execute(strContent) 
     If strType = "str" Then 
      bMatched = True 
      With objMatch 
       strWork = Replace(.Value, "|", "") 
       strWork = Replace(strWork, ";", "") 
       strLevel = get_Level(strWork) 
       strKey = "<" & lngTokenId & strLevel & strType & ">" 
       objTokens(strKey) = strWork 
       strRes = strRes & Mid(strContent, lngCopyIndex, .FirstIndex - lngCopyIndex + 1) & strKey 
       lngCopyIndex = .FirstIndex + .Length + 1 
      End With 
      lngTokenId = lngTokenId + 1 
     ElseIf strType = "par" Then 

      strKeyPar = "<" & lngTokenId & "par>" 
      strKeyVal = "<" & lngTokenId & "val>" 
      strKey = strKeyPar & strKeyVal 
      bMatched = True 
      With 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 
      End With 
      lngTokenId = lngTokenId + 2 

     End If 
    Next 
    strContent = strRes & Mid(strContent, lngCopyIndex, Len(strContent) - lngCopyIndex + 1) 
End With 
End Sub 

Function get_Level(strInput As String) As String 

Select Case strInput 
    Case "KC" 
    get_Level = "L1" 
    Case "AD" 
    get_Level = "L2" 
    Case "CD" 
    get_Level = "L3" 
    Case Else 
    MsgBox ("Error") 
    End 
End Select 

End Function 

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

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

+0

Можете ли вы показать код? Как далеко вы продвинулись? – NavkarJ

ответ

1

Я начал писать парсер в VBA для строки структуры, указанной вами, и это не полный , но я все равно отправлю его. Возможно, вы сможете получить от него некоторые идеи.

Sub ParseString() 

    Dim str As String 
    str = "|KC;|AD;PE=5;PF=3;|CD;PE=5;HP=test;|CD;PE=3;HP=abc;|" 

    ' Declare an object dictionary 
    ' Make a reference to Microsoft Scripting Runtime in order for this to work 
    Dim dict As New Dictionary 

    ' If the bars are present in the first and last character of the string, replace them 
    str = Replace(str, "|", "", 1, 1) 
    If (Mid(str, Len(str), 1) = "|") Then 
     str = Mid(str, 1, Len(str) - 1) 
    End If 

    ' Split the string by bars 
    Dim substring_array() As String 
    substring_array = Split(str, "|") 

    ' Declare a regex object 
    ' Check the reference to Microsoft VBScript Regular Expressions 5.5 in order for this to work 
    Dim regex As New RegExp 
    With regex 
     .Global = True 
     .IgnoreCase = True 
     .MultiLine = True 
    End With 

    ' Object to store the regex matches 
    Dim matches As MatchCollection 
    Dim param_name_matches As MatchCollection 
    Dim parameter_value_matches As MatchCollection 

    ' Define some regex patterns 
    pattern_for_structure_name = "^[^=;]+;" 
    pattern_for_parameters = "[^=;]+=[^=;]+;" 
    pattern_for_parameter_name = "[^=;]=" 
    pattern_for_parameter_val = "[^=;];" 

    ' Loop through the elements of the array 
    Dim i As Integer 
    For i = 0 To UBound(substring_array) - LBound(substring_array) 

     ' Get the array element in a string 
     str1 = substring_array(i) 

     ' Check if it contains a structure name 
     regex.Pattern = pattern_for_structure_name 
     Set matches = regex.Execute(str1) 

     If matches.Count = 0 Then 

      ' This substring does not contain a structure name 
      ' Check if it contains parameters 
      regex.Pattern = pattern_for_parameter 
      Set matches = regex.Execute(matches(0).Value) 
      If matches.Count = 0 Then 

       ' There are no parameters as well as no structure name 
       ' This means the string had || - invalid string 
       MsgBox ("Invalid string") 

      Else 

       ' The string contains parameter names 
       ' Add each parameter name to the dictionary 
       Dim my_match As match 
       For Each my_match In matches 

        ' Get the name of the parameter 
        regex.Pattern = pattern_for_parameter_name 
        Set parameter_name_matches = regex.Execute(my_match.Value) 

        ' Check if the above returned any matches 
        If parameter_name_matches.Count = 1 Then 

         ' Remove = sign from the parameter name 
         parameter_name = Replace(parameter_name_matches(0).Value, "=", "") 

         ' Get the value of the parameter 
         regex.Pattern = pattern_for_parameter_value 
         Set parameter_value_matches = regex.Execute(my_match.Value) 

         ' Check if the above returned any matches 
         If parameter_value_matches.Count = 1 Then 

          ' Get the value 
          parameter_value = Replace(parameter_value_matches(0).Value, ";", "") 

          ' Add the parameter name and value as a key pair to the Dictionary object 
          dict.Item(parameter_name) = parameter_value 

         Else 

          ' Number of matches is either 0 or greater than 1 - in both cases the string is invalid 
          MsgBox ("Invalid string") 

         End If 

        Else 

         ' Parameter name did not match - invalid string 
         MsgBox ("Invalid string") 

        End If 

       Next 

      End If 

     ElseIf matches.Count = 1 Then 

      ' This substring contains a single structure name 
      ' Check if it has parameter names 

     Else 

      ' This substring contains more than one structure name - the original string is invalid 
      MsgBox ("Invalid string") 

     End If 

    Next i 

End Sub 
+0

Привет @Nvj, в конце концов я решил использовать ваш подход для решения проблемы, спасибо – MeSS83

+0

@ MeSS83 Ваш прием – NavkarJ

1

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

Option Explicit 

Function 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) To UBound(a1) 
     If a1(i1) <> "" Then 
      Set c2 = New Collection 
      a2 = Split(a1(i1), ";") 
      For i2 = LBound(a2) To UBound(a2) 
       If a2(i2) <> "" Then 
        a3 = Split(a2(i2), "=") 
        If UBound(a3) > 0 Then 
         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 

    Set parseString = c1 

End Function 


Sub testParseString() 

    Dim c As Collection 

    Set 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" 

End Sub 

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

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

UPDATE: Я добавил также пример XML ниже. Взгляни.

1

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

Function parseStringToDom(str As String) As DOMDocument60 

    Dim a1() As String, i1 As Long 
    Dim a2() As 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 = False 
    dom.preserveWhiteSpace = True 

    Set rt = dom.createElement("root") 
    dom.appendChild rt 

    a1 = Split(str, "|") 
    For i1 = LBound(a1) To UBound(a1) 
     If a1(i1) <> "" Then 
      a2 = Split(a1(i1), ";") 
      Set nd = dom.createElement(a2(0)) 
      For i2 = LBound(a2) To UBound(a2) 
       If a2(i2) <> "" Then 
        a3 = Split(a2(i2), "=") 
        If 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 
    Next i1 

    Set parseStringToDom = dom 

End Function 


Sub testParseStringToDom() 

    Dim dom As DOMDocument60 

    Set 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") Is Nothing 
    Debug.Assert dom.SelectSingleNode("/root/AD/PE").Text = "5" 
    Debug.Assert dom.SelectSingleNode("/root/CD[1]/HP").Text = "test" 
    Debug.Assert dom.SelectSingleNode("/root/CD[2]/HP").Text = "abc" 

    Debug.Print dom.XML 

End Sub 

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

Это документ XML создает за кадром:

<root> 
    <KC/> 
    <AD> 
     <PE>5</PE> 
     <PF>3</PF> 
    </AD> 
    <CD> 
     <PE>5</PE> 
     <HP>test</HP> 
    </CD> 
    <CD> 
     <PE>3</PE> 
     <HP>abc</HP> 
    </CD> 
</root> 
Смежные вопросы