15.08.2018, aktualisiert um 12:34:31 Uhr

4376

Bestimmte Werte mehrere XML-Dateien einlesen

Guten Tag liebe Community,

ich arbeite an einer kleinen Excel-Datei, die mir persönlich Nerven und Zeit ersparen soll.

Sinn dieser Datei ist es, dass eine Anzahl von XML-Dateien aus einem Ordner - oder noch besser, per typischen Windows "Öffnen Dialog-Fenster"
in das Tabellenblatt1 übernommen werden soll und gleichzeitig nur die Zeilen vorhanden sein sollen, die einen bestimmten Wert aus dem Tabellenblatt 2 haben.

Als Beispiel

Im Tabellenblatt2 steht die Zahl 550 in der Zelle C2, 650 in der Zelle C3 und 780 in der Zelle C4.
Im Tabellenblatt1 stehen diese und auch andere Werte in der Spalte AS. Jetzt soll im Tabellenblatt aber nur die Zeilen angezeigt werden, die die Werte aus dem Tabellenblatt2 Zellen C2-C4 haben.

Folgende Schnipsel habe ich mir schon erschlichen, das Problem ist, dass die Löschung vom Listenende erfolgt, aber danach eine Fehlermeldung auftritt.

Sub ImportXML()
    
    Application.DisplayAlerts = False
    Worksheets("Tabelle1").Delete  
    Worksheets.Add.Name = "Tabelle1"  
    Application.DisplayAlerts = True
        
    Const XMLPATH = "C:\TEST"  
    Dim f As Object, c As Object
    Set fso = CreateObject("Scripting.Filesystemobject")  
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    With Sheets(1)
        For Each f In fso.GetFolder(XMLPATH).Files
            If LCase(fso.GetExtensionName(f.Name)) = "xml" Then  
                ActiveWorkbook.XmlImport URL:=f.Path, ImportMap:=Nothing, Overwrite:=True, Destination:=.Range("A" & .UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1)  
                ActiveWorkbook.Connections(ActiveWorkbook.Connections.Count).Delete
            End If
        Next
    End With
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    MsgBox "Importvorgang beendet!", vbInformation  
    Set fso = Nothing
   
   Dim Bereich As Range 'Anpassen der Zeilenhöhe  

Set Bereich = Tabelle1.UsedRange
Bereich.RowHeight = 15
   
End Sub

Sub t()
Dim i As Long
Dim WS1 As Worksheet, WS2 As Worksheet

Set WS1 = Worksheets("Tabelle1")  
Set WS2 = Worksheets("Tabelle2")  

For i = WS1.Range("C65536").End(xlUp).Row To 1 Step -1  
    If WorksheetFunction.CountIf(WS2.Columns(3), WS1.Cells(i, 2)) = 0 Then _
    WS1.Rows(i).Delete

Next i
End Sub

Ich weiß, guter Rat ist teuer und die Arbeit soll auch bezahlt werden,
aber das Projekt ist für mich persönlich und ich habe ungelogen schon mehrere Stunden hineingesteckt und verzweifle langsam.

Vielen Dank im Voraus!

Gruß

Mounzer

Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben

Content-ID: 383433

Url: https://administrator.de/forum/bestimmte-werte-mehrere-xml-dateien-einlesen-383433.html

Ausgedruckt am: 14.05.2025 um 06:05 Uhr

7 Kommentare

Neuester Kommentar

Hi,
ein Tipp: präzisiere Deinen Text!

"C2", "C3" und "C4" sind Zellen, keine Zeilen.

Jetzt soll im Tabellenblatt

Ein welchem von beiden?

dem Tabellenblatt C2-C4

s.o. Das sind Zellen

E.

Habe ich soeben geändert, haben Sie diesbezüglich auch eine Hilfestellung für mich?

Fingerübung ...

Sub ImportXML()
    Dim rngTarget As Range, r As Range, files As Variant, f As Variant
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    
    With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = True
        .Title = "Bitte die XML Dateien für den Import auswählen"  
        .Filters.Add "XML-Datei", "*.xml", 1  
        If .Show = -1 Then
            Set files = .SelectedItems
        Else
            Exit Sub
        End If
    End With

    With Sheets(1)
        .UsedRange.Clear
        For Each f In files
            Set rngTarget = .Range("A" & .Cells(Rows.Count, "A").End(xlUp).row + 1)  
            ActiveWorkbook.XmlImport URL:=f, ImportMap:=Nothing, Overwrite:=True, Destination:=rngTarget
            With rngTarget.ListObject
                .AutoFilter.Range.AutoFilter Field:=Columns("AS").Column, Criteria1:=Array(Sheets(2).Range("C2").Text, Sheets(2).Range("C3").Text, Sheets(2).Range("C4").Text), Operator:=xlFilterValues  
                For Each r In .DataBodyRange.Rows
                    If r.Hidden Then r.EntireRow.Delete
                Next
                .AutoFilter.Range.AutoFilter Field:=2
            End With
            ThisWorkbook.Connections(ActiveWorkbook.Connections.Count).Delete
        Next
    End With
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    MsgBox "Importvorgang beendet!", vbInformation  
End Sub

Ich weiß, guter Rat ist teuer und die Arbeit soll auch bezahlt werden,

Immer gerne.

Grüße Uwe

Zitat von @colinardo:
Fingerübung ...

Angeber!

Zitat von @emeriks:
Angeber!

Dauergrinser

Habe wegen der Fingerübung fast einen Lachanfall bekommen.

Erst mal vielen Dank!
Es funktioniert aber nicht so ganz, ich glaube es hängt nur noch an einer kleinen Änderung.

Er zeigt mir die Liste an, aber alle Werte aus der Spalte AS sind nicht vorhanden und sogar die Zeilen, mit dem Referenzwert aus Tabellenblatt2 ZELLE C4

sind gelöscht.

Geht das auch ohne Autofilter? Am besten wäre es, wenn der Wert nicht dabei ist, soll auch nichts angezeigt werden, in Ausnahmen kommt dann auch ein leeres Blatt zum Vorschein.

Gruß und vielen Dank!

Zitat von @Mounzer2029:
Er zeigt mir die Liste an, aber alle Werte aus der Spalte AS sind nicht vorhanden und sogar die Zeilen, mit dem Referenzwert aus Tabellenblatt2 ZELLE C4

sind gelöscht.

Ohne deine Daten kann ich das nicht nachstellen, hier geht es einwandfrei.

Geht das auch ohne Autofilter?

Klar über foreach über alle Zeilen, nur wieso? Geht ja schön effizient damit

. Die Daten liegen ja sowieso in einem List-Object die haben das by default.

Am besten wäre es, wenn der Wert nicht dabei ist, soll auch nichts angezeigt werden, in Ausnahmen kommt dann auch ein leeres Blatt zum Vorschein.

Kann man alles machen.

Schick mir ein zwei Demo-XML-Files und ich kann dir auch dabei helfen.

Frage VB for Applications Entwicklung

Heiß diskutiert