Maximalwerte aus mehreren .txt Dateien Sammeln

Hallo!

Habe leider sehr wenig erfahrung mit Excel und Makros und hoffe ich suche hier an der richtigen Stelle nach Hilfe.
Es geht um folgendes:

Ich habe einige .txt Dateien in denen Messwerte gespeichert sind, sie befinden sich im selben Ordner. Ich möchte nun, dass ein Makro jede dieser Dateien öffnet, das Maximum in Spalte B zwischen Zeile 428 und 1313 ermittelt, und dieses Neben Dateiname und zugehörigem Spalte-A-Wert in einer Tabelle auflistet.

Von Hand würde das viel zu lange dauern.

Vielen Dank für die Hilfe!

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

Content-ID: 294166

Url: https://administrator.de/forum/maximalwerte-aus-mehreren-txt-dateien-sammeln-294166.html

Ausgedruckt am: 30.04.2025 um 04:04 Uhr

2 Kommentare

Neuester Kommentar

Moin,
wie sieht so eine Textdatei aus (CSV / Trennzeichen/etc) ?

Ich gehe einfach mal von folgender Formatierung aus:

Überschrift1;Überschrift2
100;20,345
200;55,45
300;44,12
400;38,22

und das die Textdateien die Endung *.txt haben und im selben Verzeichnis wie diese Excel-Mappe liegen. Dann kannst du die von dir erwarteten zusammengefassten Daten hiermit in das erste Tabellenblatt ("Tabelle1") importieren.
Je nach Character-Encoding und Trennzeichen deiner Dateien muss man die Importparameter noch anpassen (Zeilen 24-34) wenn sie sich von obigen Angaben unterscheiden.

Sub ImportiereMessdaten()
    Dim wsTemp As Worksheet, wsTarget As Worksheet, strPathFiles
    'Textdateien liegen im selben Verzeichnis wie die Excel-Mappe  
    strPathFiles = ThisWorkbook.Path
    
    Set fso = CreateObject("Scripting.Filesystemobject")  
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    
    'Zielarbeitsblatt für die importierten Daten  
    Set wsTarget = Worksheets(1)
    'temporäres Arbeitsblatt für den Import der Daten erstellen  
    Set wsTemp = Worksheets.Add(After:=Worksheets(Worksheets.Count))
    
    'Inhalt des Zusammenfassungsblattes löschen  
    wsTarget.UsedRange.Clear
    
    For Each f In fso.GetFolder(strPathFiles).Files
        If LCase(fso.GetExtensionName(f.Name)) = "txt" Then  
            'Temporäres Sheet löschen  
            wsTemp.UsedRange.Clear
            'Daten in Temporäres Sheet importieren  
            With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & f.Path, Destination:=wsTemp.Range("$A$1"))  
                .Name = "import"  
                .FieldNames = True
                .AdjustColumnWidth = True
                .RefreshPeriod = 0
                ' Format der Dateien festlegen (momentan ANSI)  
                .TextFilePlatform = 1252
                .TextFileStartRow = 1
                .TextFileParseType = xlDelimited
                .TextFileTextQualifier = xlTextQualifierDoubleQuote
                'Semikolon als Trennzeichen festlegen  
                .TextFileSemicolonDelimiter = True
                .Refresh BackgroundQuery:=False
                .Delete
            End With
            
            With wsTemp
                ' Bereich absteigend sortieren  
                .Range("A428:B1313").Sort .Columns(2), xlDescending, Header:=xlNo  
                ' Maximaldaten in Zusammenfassungssheet schreiben  
                wsTarget.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Resize(1, 3).Value = Array(f.Name, .Range("A428"), .Range("B428"))  
            End With
        End If
    Next
    'Temporäres Sheet löschen  
    wsTemp.Delete
    'Spalten im Zusammenfassungssheet anpassen  
    wsTarget.Columns.AutoFit
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    
    MsgBox "Vorgang beendet!", vbInformation  
    Set fso = Nothing
End Sub