Ecxel 2010 Macro txt import nur bestimmte Zeilen

Hallo,

ich hoffe das man mir helfen kann.
Ich habe ein Makro aufgenommen welches mir eine txt Datei importiert, welches auch funktioniert.
Nun möchte ich aber nicht alle Zeilen Importieren sonder nur bestimmt Zeilen welches ein oder zwei Schlüßelwörter (bytes from + icmp) enthält.

Kann mir jemand helfen wie ich dies mit dem unden geposteten Code umsetzen kann?

Vielen Dank vorab für die Hilfe.

Dies ist eine Beispiel txt welche importiert werden soll.
Hier sollen nur die Ping antwortzeiten Importiert werden.

ipAddress 172.58.86.44

13.07.2015 20:58.....

13.07.2015 20:59.....

ping sequence.................

13.07.2015 21:00.....pkt loss,rtt min,avg,max,mdev
ping -i 1 -s 40 -w 900 172.58.86.44

Mon Jul 13 21:00:22 CEST 2015

PING 172.58.86.44 (172.58.86.44) 40(68) bytes of data.

NUR die GRÜNEN Zeilen sollen Importiert werden

48 bytes from 172.58.86.44: icmp_seq=1 ttl=58 time=79.0 ms
48 bytes from 172.58.86.44: icmp_seq=2 ttl=58 time=55.8 ms
48 bytes from 172.58.86.44: icmp_seq=3 ttl=58 time=49.7 ms
48 bytes from 172.58.86.44: icmp_seq=4 ttl=58 time=48.1 ms
48 bytes from 172.58.86.44: icmp_seq=5 ttl=58 time=49.5 ms
48 bytes from 172.58.86.44: icmp_seq=6 ttl=58 time=50.1 ms
48 bytes from 172.58.86.44: icmp_seq=74 ttl=58 time=49.1 ms
48 bytes from 172.58.86.44: icmp_seq=75 ttl=58 time=49.5 ms
48 bytes from 172.58.86.44: icmp_seq=76 ttl=58 time=47.0 ms
48 bytes from 172.58.86.44: icmp_seq=77 ttl=58 time=48.6 ms
48 bytes from 172.58.86.44: icmp_seq=78 ttl=58 time=57.1 ms
48 bytes from 172.58.86.44: icmp_seq=79 ttl=58 time=49.6 ms

--- 172.58.86.44 ping statistics ---
899 packets transmitted, 898 received, 0% packet loss, time 899273ms
rtt min/avg/max/mdev = 57.915/67.079/127.021/5.028 ms

 
   ' DIes ist der Code zum aufgenommenen Makro  
   SetCurrentDirectory "d:\Analyse\"  
   ' GetOpenFile  

    Filename = Application _
    .GetOpenFilename("Text Files (*.txt), *.txt")  
    If Filename <> False Then
    MsgBox "Ausgewählte Datei wird nach drücken der OK Taste importiert: " & Filename, vbInformation, "Information"  
    End If
    
    Sheets("Tabelle1").Select  
    Range("A1:J400000").Select  
    Selection.ClearContents
    Range("A1").Select  
    
        
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;" & Filename _  
        , Destination:=Range("$A$1"))  
        .Name = "log1"  
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 850
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierSingleQuote
        .TextFileConsecutiveDelimiter = True
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = True
        .TextFileOtherDelimiter = "="  
        .TextFileColumnDataTypes = Array(2, 2, 2, 1, 2, 1, 2, 2, 2, 1, 2)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    Range("D1").Select  
    ActiveWindow.SmallScroll Down:=-21
    ActiveCell.FormulaR1C1 = "IP"  
    Range("A1").Select  
    ActiveCell.FormulaR1C1 = "Ping"  
    Range("B1").Select  
    ActiveCell.FormulaR1C1 = "bytes"  
    Columns("C:C").Select  
    Selection.Delete Shift:=xlToLeft
    Range("D1").Select  
    ActiveCell.FormulaR1C1 = "icmp_seq"  
    Range("E1").Select  
    ActiveCell.FormulaR1C1 = "seqWert"  
    Range("F1").Select  
    ActiveCell.FormulaR1C1 = "ttl"  
    Range("G1").Select  
    ActiveWindow.SmallScroll Down:=-36
    ActiveCell.FormulaR1C1 = "ttlWert"  
    Columns("H:H").Select  
    Selection.Delete Shift:=xlToLeft
    Range("H1").Select  
    ActiveCell.FormulaR1C1 = "Time"  
    Columns("I:I").Select  
    Selection.Delete Shift:=xlToLeft
    Rows("2:2").Select  
    Selection.Delete Shift:=xlUp
    ActiveWindow.SmallScroll Down:=390
    Selection.Replace What:="^C", Replacement:="", LookAt:=xlPart, _  
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    ActiveWindow.SmallScroll Down:=-417

Hoffe mir kann jemand helfen.

Danke
Gruß
Andreas

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

Content-ID: 277516

Url: https://administrator.de/forum/ecxel-2010-macro-txt-import-nur-bestimmte-zeilen-277516.html

Ausgedruckt am: 12.04.2025 um 08:04 Uhr

7 Kommentare

Neuester Kommentar

Moin,
Kommentare sind im Code

Sub Import()
    Dim fso As Object, strContent As String, rngCurrent As Range, regex As Object, strFilename As Variant, strBytes As String
    'Objekte erstellen  
    Set fso = CreateObject("Scripting.FileSystemObject")  
    Set regex = CreateObject("vbscript.regexp")  
    regex.Global = True: regex.IgnoreCase = True
    'Datei auswählen  
    strFilename = Application.GetOpenFilename("Text Files (*.txt;*.log), *.txt;*.log")  
    If strFilename <> False Then
        strBytes = InputBox("Bitte geben sie die Byte-Größe zur Filterung an:", "Abfrage Bytes", "88")  
        If Not IsNumeric(strBytes) Then
            MsgBox "Eingegebener Wert ist nicht numerisch, importiere alle Einträge!", vbExclamation  
            strBytes = "\d*"  
        End If
        MsgBox "Ausgewählte Datei wird nach drücken der OK Taste importiert: " & Filename, vbInformation, "Information"  
    Else
        Exit Sub
    End If
    
    'Regex Pattern für die gewünschten Zeilen  
    regex.Pattern = "(" & strBytes & ") bytes from ([\d\.]*): icmp_seq=(\d*) ttl=(\d*) time=([\d\.]*) ms"  
    
    ' Überschriften setzen  
    With ActiveSheet.Range("A1:E1")  
        .Value = Array("BYTES", "IP", "SEQ", "TTL", "TIME")  
        .Font.Bold = True
    End With
    'Startzelle für den Import ermitteln  
    Set rngCurrent = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)  
    'Text importieren  
    strContent = fso.OpenTextFile(strFilename, 1).ReadAll()
    ' regular Expression auf die Zeilen ausführen  
    Set matches = regex.Execute(strContent)
    If matches.Count > 0 Then
        'Importiere die Zeilen  
        For Each Match In matches
            rngCurrent.Resize(1, 5).Value = Array(Match.Submatches(0), Match.Submatches(1), Match.Submatches(2), Match.Submatches(3), Match.Submatches(4))
            Set rngCurrent = rngCurrent.Offset(1, 0)
        Next
    Else
        MsgBox "Keine entsprechenden Zeilen gefunden!", vbExclamation  
    End If
    'Objects releasen  
    Set regex = Nothing
    Set fso = Nothing
End Sub

Ergebnis sieht dann so aus:

Gruß grexit

edit Kleinigkeit korrigiert ...

Hallo,

danke für deine schnelle Hilfe.

Leider bringt er mir in folgender Zeile einen Fehler:
strContent = fso.OpenTextFile(Filename, 1).ReadAll()

Wäre es noch möglich, das *.txt und *.log Dateien angezeigt bzw importiert werden können.

Danke
Gruß
Andreas

ider bringt er mir in folgender Zeile einen Fehler:

Den hatte ich oben bereits nachträglich korrigiert .. war nur eine falsch geschriebene Variable.

Wäre es noch möglich, das *.txt und *.log Dateien angezeigt bzw importiert werden können.

Ist eingebaut.

Super vielen Dank, funktioniert einwandfrei.

Jetzt hätte ich noch eine Frage ob das noch möglich wäre:

48 172.18.80.1 897 58 49,9
48 172.18.80.1 898 58 48,6
48 172.18.80.1 899 58 51
88 172.18.80.1 1 58 52,2
88 172.18.80.1 2 58 51,3

In diesen zu importierenden Logfiles sind jeweil in Spalte A unterschiedliche Bytes Angaben.
Wäre es möglich vor dem Import eine Usereingabe einzubauen welche mich fragt welche ich Importieren möchte.

Also im diesem Fall nur die Zeilen wo 88 in Zeile A steht. Die anderen soll er nicht importieren.

Zeile A kann verschiedene Werte enthalten aber immer eine gerade Zahl. (Bytes)

Vielen Dank

Gruß
Andreas

Ist eingebaut ...

Weitere Anpassung nur noch gegen Cash

Wenns das dann war, den Beitrag bitte noch auf gelöst setzen.

Funktioniert wieder super. ;)

Könntest du noch alle Spalten von A bis I als Zahlen formatieren und die Tabelle in Worksheet:Tabelle1 einfügen lassen.
Zudem mus die Spalte Time mit Komma (derzeit mit Punkt) und Zweistellig angezeigt werden.

Jetzt werd ich langsam nervig oder ;)

Danke