Projekt-Anfragen: Tel: 07022/9319004 info@CodeDocu.de Software Entwicklung in C# WPF Asp.Net Core Vba Excel Word SQL-Server EF Linq, UWP Net
#

Download:

Datei 1: demo_29a_convert_XML_to_Text_Cells.xlsm

Excel: Umwandeln von XML zu einfachen Text Werte Paaren

 

Aufgabe: strukturierte XML Zeilen in einfachen Text mit Werte-paaren umwandeln.

 

Unter XML findet man sehr häufig eine Auflistung von Werten auf der kleinsten Knotenebene.

Allerdings ist die Verschachtelung mit XML-Code nur schwer lesbar.

 

Mit Excel kann man hieraus recht einfache tabellarische Auswertungen erreichen.

 

Hier eine Umwandlung von XML (links) zu Text-Wert Paaren (rechts)

 

 

Konvertierung XML in Excel:

1. Kopieren der XML Baums

2. Einfügen in Excel als zeilenweiser Block

3. Markieren der Spalte die konvertiert werden soll

4. Konvertieren von XML in Text und Wert in der benachbarten Spalte durch das beliegende Makro

  


Ablauf:

Die XML-Datei im Browser wie MS Edge oder Google Chrome öffnen, sodass die Struktur per XML-Tree angezeigt wird.

Anschliessende alles markieren und kopieren oder nur die Segmente markieren, welche man wirklich benötigt.

Hier die XML Ansicht als Struktur geöffnet im Microsoft Browser Edge.

 

Einfügen in Excel:

Wenn man diese Kopie dann in Excel einfügt, werden automatisch die Zeilen wie hier dargestellt eingefügt.

 

Dieses XML Beispiel basiert zum Beispiel auf ganz einfachen Text-Werte Paaren

<SystemScore>6.3</SystemScore>

<MemoryScore>7.8</MemoryScore>

<CpuScore>7.8</CpuScore>

<CPUSubAggScore>7.9</CPUSubAggScore>

<VideoEncodeScore>7.6</VideoEncodeScore>

<GraphicsScore>6.3</GraphicsScore>

<Dx9SubScore>9.9</Dx9SubScore>

<Dx10SubScore>9.9</Dx10SubScore>

<GamingScore>9.9</GamingScore>

<StdDefPlaybackScore>TRUE</StdDefPlaybackScore>

<HighDefPlaybackScore>TRUE</HighDefPlaybackScore>

<DiskScore>6.85</DiskScore>

 

Konvertieren in Excel.

Unter Excel werden diese XML Text-Zeilen umgewandelt in Text-Werte Paare

SystemScore

6,3

MemoryScore

7,8

CpuScore

7,8

CPUSubAggScore

7,9

VideoEncodeScore

7,6

GraphicsScore

6,3

Dx9SubScore

9,9

Dx10SubScore

9,9

GamingScore

9,9

StdDefPlaybackScore

WAHR

HighDefPlaybackScore

WAHR

DiskScore

6,85

 

 

 

 

 

Excel Makro Code zum Download und selber einfügen in eine Excel Datei

 

Sub Convert_XML_to_Single_Text_Value_Pairs()

    '------------------------< Convert_XML_to_Single_Text_Value_Pairs() >------------------------

    Dim xmlRange As Range

    Dim cell As Range

    Dim sText As String

    Set xmlRange = Selection

   

    Dim bMatch As Boolean

    Dim iCell As Integer

    iCell = 0

    For Each cell In xmlRange.Cells

        '--------< Cell >--------

        DoEvents

        iCell = iCell + 1

        If iCell > 5000 Then Exit For

        bMatch = False

 

 

        '< get Cell >

        sText = cell.Text

        '</ get Cell >

 

        '< vars>

        Dim posXML1_Start As Integer

        Dim posXML1_End As Integer

        Dim posNext As Integer

 

        Dim posXML2_Start As Integer

        Dim posXML2_End As Integer

        '</ vars>

 

        '------< Check Tags >------

        posXML1_Start = InStr(1, sText, "<", vbBinaryCompare)

        If posXML1_Start > 0 Then

            '------< Check XML1 >------

            posXML1_End = InStr(posXML1_Start, sText, ">", vbBinaryCompare)

            If posXML1_End > 0 Then

                '----< has XML1 >----

                posXML2_Start = InStr(posXML1_Start + 1, sText, "<", vbBinaryCompare)

                If posXML1_End < posXML2_Start Then

                    '------< Check EndTag >------

                    posXML2_End = InStr(posXML2_Start + 1, sText, ">", vbBinaryCompare)

                    If posXML2_End > 0 Then

                        '----< has XML2 >----

                        '< check islast >

                        If InStr(posXML2_Start + 1, sText, "<", vbBinaryCompare) = 0 Then

                            '----< Is single-XML Row >----

                            Dim sTag1 As String

                            sTag1 = Mid$(sText, posXML1_Start + 1, posXML1_End - posXML1_Start - 1)

 

                            Dim sTag2 As String

                            sTag2 = Mid$(sText, posXML2_Start + 1, posXML2_End - posXML2_Start - 1)

 

                            '< get ID >

                            Dim sID As String

                            Dim posSpace As Integer

                            posSpace = InStr(1, sTag1, " ", vbBinaryCompare)

                            If posSpace > 0 Then

                                sID = Mid(sTag1, 1, posSpace)

                            Else

                                sID = sTag1

                            End If

                            sID = Trim(sID)

                            '</ get ID >

 

                            '< check EndID >

                            sTag2 = Replace(sTag2, "/", "", 1, 1, vbBinaryCompare)

 

                            If sID = sTag2 Then

                                '----< Single-XML OK >----

                                '< get Innertext >

                                Dim sInnerText As String

                                sInnerText = Mid$(sText, posXML1_End + 1, posXML2_Start - posXML1_End - 1)

                                '</ get Innertext >

 

                                '--< output >--

                                Cells(cell.Row, cell.Column + 2).Value = sID

                                Cells(cell.Row, cell.Column + 3).Value = sInnerText

                                bMatch = True

                                '--</ output >--

                                '----</ Single-XML OK >----

                            End If

 

                            '</ check EndID >

                            '----</ Is single-XML Row >----

                        End If

                        '</ check islast >

                        '----</ has XML2 >----

                    End If

                    '------</ Check EndTag >------

                End If

                '----</ has XML1 >----

            End If

            '------</ Check XML1 >------

        End If

        '------</ Check Tags >------

 

 

        '--< default output >--

        If bMatch = False Then

            Cells(cell.Row, cell.Column + 1).Value = sText

        End If

        '--</ default output >--

        '--------</ Cell >--------

    Next

    '------------------------< Convert_XML_to_Single_Text_Value_Pairs() >------------------------

End Sub

 

 

 

 

Mobile
»
Excel: Stundenzettel Kalenderaufschrieb als Download Vorlage
»
Excel : Werte kodieren mit HASH Funktionen SHA256
»
Excel : Nummern Anonymizieren und Pseudonymizieren
»
Excel Formulare in eine Excel Datenbank einlesen und verwalten
»
Excel: Umwandeln von XML zu einfachen Text Werte Paaren
»
Excel Word: mit Excel einen Serienbrief in Word erstellen per vba Code
»
Excel Vorlage: Link-Sammlung vom Browser in Excel Liste Tabelle umwandeln 02
»
Excel Vorlage: Liste mit Links aus Chrome umwandeln in Excel-Liste mit aktiven Links
»
Umwandeln aller Verweise auf eine externe Arbeitsmappe durch lokale Werte
»
Stundenplan als Excel Vorlage

.

Jobs, Projekte, Angebote für Freiberufler, Selbstständig an Info@CodeDocu.de