xml to excel

Hallo Gemeinde,
habe lang im Internet gesucht aber nur individuelle Beispiele für eine xml in excel auszulesen gefunden.
Ich möchte bestimmte Knoten auslesen und im Tabelle1 ab A22...... eintragen.
Die Tabellen Spalten die zu befüllen sind sollen variable sein und von mir ergänzt wenn nötig.
Das heißt immer, wenn ich mehr Daten benötige, kann ich im Code die gesuchten Zeilen dazu schreiben.
Hier eine xml Datei:
https://www.herber.de/bbs/user/153337.zip
und hier die Exceltabelle mit dem knoten die ich möchte, die Knoten sind zwar schon ausgefüllt, es dient nur zu Kontrolle:
https://www.herber.de/bbs/user/153338.xlsx
Ich hoffe das jemend hier im Forum mir helfen kann.
Vielen Dank im Voraus
LG Antonio

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: xml to excel

31.05.2022 09:15:23

Antonio

AW: xml to excel

31.05.2022 11:44:29

UweD

AW: xml to excel

31.05.2022 12:05:58

Antonio

AW: xml to excel

31.05.2022 12:24:53

UweD

AW: xml to excel

31.05.2022 12:42:45

Antonio

Prima. Danke für die Rückmeldung. owT

31.05.2022 12:53:35

UweD

AW: @ UweD

01.06.2022 06:55:00

Antonio

AW: @ UweD

01.06.2022 08:20:49

UweD

AW: @ UweD

01.06.2022 08:45:00

Antonio

Sub Keywords() Dim Datei As String, ZZ As Integer, Z1 As Integer, LC As Integer, LR As Long Dim Wb As Workbook, Tb As Worksheet, i As Integer, Spalte As Integer, SW As String Datei = "E:\Excel\Temp\Black Orpheus_1.xml" ZZ = 18 'Zeile mit den Vorgaben Z1 = 2 ' Kopfzeile in xml-Datei Set Tb = ThisWorkbook.Sheets("Tabelle1") 'XML Datei wird geöffnet Set Wb = Workbooks.Open(Filename:=Datei) LR = Tb.Cells.SpecialCells(xlCellTypeLastCell).Row 'Letzte Zeile des gesamten Blattes LC = Tb.Cells(ZZ, Tb.Columns.Count).End(xlToLeft).Column 'letzte Spalte einer Zeile 'Reset Tb.Rows(ZZ + 1).Resize(LR).ClearContents With Wb.Sheets(1) LR = .Cells.SpecialCells(xlCellTypeLastCell).Row For i = 1 To LC SW = Trim(Tb.Cells(ZZ, i)) 'Suchwort If SW "" And WorksheetFunction.CountIf(.Rows(Z1), "*" & SW) > 0 Then 'ist Begriff vorhanden? 'in welcher Spalte Spalte = WorksheetFunction.Match("*" & SW, .Rows(Z1), 0) 'kopieren .Cells(Z1 + 1, Spalte).Resize(LR - Z1 + 1, 1).Copy Tb.Cells(ZZ + 1, i) End If Next End With Wb.Close False 'Schließen ohne speichern End Sub

Hallo nochmal
&GT&GT Das heißt so wie ich dein Code verstehe, brauche nur ein SUCHWORT dazu zu schreiben oder ein SUCHWORT zu löschen
oder die SUCHWÖRTER umstellen das es genauso funzt, stimmt?
Ja, genau nur das was du in Zeile 18 wird gesucht und kopiert.
Übrigens in A18 reicht auch einfach nur /credit-words
Hier noch ein Update mit Fehlermeldung.


Sub Keywords()
Dim Datei As String, ZZ As Integer, Z1 As Integer, LC As Integer, LR As Long
Dim Wb As Workbook, Tb As Worksheet, i As Integer, Spalte As Integer, SW As String
Datei = "E:\Excel\Temp\Black Orpheus_1.xml"
ZZ = 18 'Zeile mit den Vorgaben
Z1 = 2 ' Kopfzeile in xml-Datei
Set Tb = ThisWorkbook.Sheets("Tabelle1")
Application.ScreenUpdating = False
'XML Datei wird geöffnet
Set Wb = Workbooks.Open(Filename:=Datei)
LR = Tb.Cells.SpecialCells(xlCellTypeLastCell).Row 'Letzte Zeile des gesamten Blattes
LC = Tb.Cells(ZZ, Tb.Columns.Count).End(xlToLeft).Column 'letzte Spalte einer Zeile
'Reset
Tb.Rows(ZZ + 1).Resize(LR).ClearContents
With Wb.Sheets(1)
LR = .Cells.SpecialCells(xlCellTypeLastCell).Row
For i = 1 To LC
SW = Trim(Tb.Cells(ZZ, i)) 'Suchwort
If SW  "" Then
If WorksheetFunction.CountIf(.Rows(Z1), "*" & SW) > 0 Then 'ist Begriff vorhanden?
'in welcher Spalte
Spalte = WorksheetFunction.Match("*" & SW, .Rows(Z1), 0)
'kopieren
.Cells(Z1 + 1, Spalte).Resize(LR - Z1 + 1, 1).Copy Tb.Cells(ZZ + 1, i)
Else
MsgBox SW & ": wurde nicht gefunden"
End If
End If
Next
End With
Wb.Close False 'Schließen ohne speichern
End Sub

LG UweD

Sub Keywords() Dim Datei As String, ZZ As Integer, Z1 As Integer, LC As Integer, LR As Long, S1 As Integer Dim Wb As Workbook, Tb As Worksheet, i As Integer, Spalte As Integer, SW As String Datei = "E:\Excel\Temp\Black Orpheus_1.xml" ZZ = 22 'Zeile mit den Vorgaben Z1 = 2 'Kopfzeile in xml-Datei S1 = 5 'Erste Spalte = E Set Tb = ThisWorkbook.Sheets("Tabelle1") Application.ScreenUpdating = False 'XML Datei wird geöffnet Set Wb = Workbooks.Open(Filename:=Datei) LR = Tb.Cells.SpecialCells(xlCellTypeLastCell).Row 'Letzte Zeile des gesamten Blattes LC = Tb.Cells(ZZ, Tb.Columns.Count).End(xlToLeft).Column 'letzte Spalte einer Zeile 'Reset Tb.Rows(ZZ + 1).Resize(LR).ClearContents With Wb.Sheets(1) LR = .Cells.SpecialCells(xlCellTypeLastCell).Row For i = S1 To LC SW = Trim(Tb.Cells(ZZ, i)) 'Suchwort If SW "" Then If WorksheetFunction.CountIf(.Rows(Z1), "*" & SW) > 0 Then 'ist Begriff vorhanden? 'in welcher Spalte Spalte = WorksheetFunction.Match("*" & SW, .Rows(Z1), 0) 'kopieren .Cells(Z1 + 1, Spalte).Resize(LR - Z1 + 1, 1).Copy Tb.Cells(ZZ + 1, i) Else MsgBox SW & ": wurde nicht gefunden" End If End If Next End With Wb.Close False 'Schließen ohne speichern End Sub

Beliebteste Forumthreads (12 Monate)

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread