XML мультилинии в одну строку с использованием VBA - PullRequest
0 голосов
/ 13 апреля 2020

У меня есть файл Excel. Одна из ячеек содержит скрипт XML. Мне нужно получить содержимое этой ячейки и вставить их в блокнот. Я закончил со всем, кроме того, что я не могу поместить весь скрипт XML в одну строку. Без пробелов после и до тегов и без символов новой строки Пожалуйста помогите. Чтобы сохранить конфиденциальность данных клиента, я вставил ниже пример скрипта XML. Этот скрипт должен находиться в ячейке B7 Excel.

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

PS Я также пытался использовать функцию обрезки, но это не помогло Работа.

Range("B7").Value = Trim(Range("B7").Value)

XML Сценарий -

<Tag1>
    <Tag2 xml version="1.0"/>
    <Tag3>
        <Tag4 name="Tag4">Hello</Tag4>
    </Tag3>
</Tag1> 

Ответы [ 3 ]

3 голосов
/ 13 апреля 2020
Function manyToOne(str As String)
    Do Until InStr(str, Chr(10) & " ") = 0
        str = Replace(str, Chr(10) & " ", Chr(10))
    Loop
    str = Replace(str, Chr(10), "")
    manyToOne = str
End Function

тогда вы можете позвонить с листа:

=manyToOne(A1)

enter image description here

1 голос
/ 13 апреля 2020

Попробуйте эту функцию, пожалуйста:

Function UniqueXMLStr(strXML) As String
  Dim arrXML As Variant, strUnique As String

   arrXML = Split(strXML, vbLf)
   strUnique = Join(arrXML, "")
   UniqueXMLStr = Replace(strUnique, "    ", "")
End Function

Это можно проверить с помощью следующего теста Sub:

Sub testUnique()
    Dim cel As Range
    Set cel = ActiveCell 'here you will have your example XML string
    Debug.Print UniqueXMLStr(cel.value) 'Here the unique string will be shown in Immediate Window (Ctrl + G in Visual Basic Editor)...
End Sub
0 голосов
/ 13 апреля 2020

Попробуйте заменить Chr (10) ничем

Sub Test()
Dim sInput As String
sInput = Range("A1").Value
sInput = Application.WorksheetFunction.Trim(Replace(sInput, Chr(10), ""))
Debug.Print sInput
End Sub

Еще один способ избавиться от пробелов

Sub Test2()
Dim x, sOut As String, i As Long
x = Split(Range("A1").Value, Chr(10))
For i = LBound(x) To UBound(x)
    sOut = sOut & Application.WorksheetFunction.Trim(x(i))
Next i
Debug.Print sOut
End Sub

Другой подход с использованием Regex

Sub Test_Using_Regex()
Dim sInput As String
sInput = Join(Split(Range("A1").Value, Chr(10)), "")
With CreateObject("VBScript.RegExp")
    .Pattern = ">(\s*)<"
    If .Test(sInput) Then Debug.Print Replace(Trim(sInput), .Execute(sInput)(0).SubMatches(0), "") '.Replace(sInput, "$1")
End With
End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...