sims
Goto Top

Excel: Höchsten Wert pro Tag auslesen und in ein neues Excel File überspielen

Hall Leute, ich benötige wieder mal eurer KNOW HOW!

Ich habe eine *.csv Datei welche sehr viele Messwerte enthält (mehrere Messpunkte pro Tag). Jetzt benötige ich eure Hilfe, denn ich wurde jetzt gerne aus der csv Datei nur den Höchsten Wert pro Tag haben so das man pro Tag nur einen Wert hat. Und wurde diesen Wert dann gerne in einer neunen Excel Datei zusammenführen.

Ich hoffe es kann mir wer weiter helfen.

Anbei der LINK zu der csv Datei:
http://we.tl/ABg4DL79Dg


Besten DANK für eure Hilfe!

Content-Key: 256026

Url: https://administrator.de/contentid/256026

Ausgedruckt am: 29.03.2024 um 11:03 Uhr

Mitglied: 114757
114757 27.11.2014 um 10:22:39 Uhr
Goto Top
Mitglied: sims
sims 27.11.2014 aktualisiert um 12:34:29 Uhr
Goto Top
face-big-smile DANKE - stimmt man wird vergesslich!!!

Hab es soeben mit diesem Code versucht aber leider spielt er mit nur eine Zeile aus dem csv File raus und zwar die
02.11.2014 12:00 655,33 und das wars dann.

Das liegt wahrscheinlich daran das man mit diesem Code aus sehr viellen einzelnen csv Dateien, den jeweils höchsten Wert auslesen kann und in ein neues Excel File spielen kann.

Und jetzt habe ich aber ein csv File wo die ganzen Daten (mehrere Werte pro Tag) gelistet sind.

Irgendwie bekomm ich das nicht richtig zum laufen - vielleicht kann mir wer helfen?

Besten DANK

Hier der CODE:

Sub CSV_Import()
    Dim vntaDateien As Variant
    Dim lngI As Long
    Dim lngLetzteZeile As Long
    Dim wbkCSV As Workbook
    Dim wksZiel As Worksheet
    Dim rOut As Range
    Set rOut = Range("A1")  
    lngLetzteZeile = 1
    With rOut.Range("A1:G1").Resize(rOut.Worksheet.Rows.Count - rOut.Row + 1)  
        .ClearContents
        .Rows(1).Value = Split("Date,Time,Durchfluss1,Durchfluss2,lt101 cm,lt102 cm,tt101 C", ",")  
    End With
    lngLetzteZeile = 1
    vntaDateien = Application.GetOpenFilename _
    ("csv-Dateien (*.csv), *.csv", MultiSelect:=True)  
    If IsArray(vntaDateien) Then
        Set wksZiel = ThisWorkbook.Sheets(1)
        For lngI = 1 To UBound(vntaDateien)
            lngLetzteZeile = wksZiel.UsedRange.Rows.Count
            lngLetzteZeile = ActiveSheet.Cells(1048576, 1).End(xlUp).Row
            Set wbkCSV = Workbooks.Open(vntaDateien(lngI), local:=True)
            'sortieren  
            wbkCSV.Worksheets(1).Sort.SortFields.Clear
            wbkCSV.Worksheets(1).Sort.SortFields.Add Key:=Range("C2:C1048576"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal  
            wbkCSV.Worksheets(1).Sort.SortFields.Add Key:=Range("D2:D1048576"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal  
            With wbkCSV.Worksheets(1).Sort
                .SetRange Range("A1:G1048576")  
                .Header = xlYes
                .MatchCase = False
                .Orientation = xlTopToBottom
                .Apply
            End With
            'Zeilen 3 bis Ende löschen  
            wbkCSV.Worksheets(1).Rows("3:1048576").Delete shift:=xlUp  
            'Dateiname kopieren  
            'wksZiel.Cells(lngLetzteZeile + 1, 1) = vntaDateien(lngI)  
            'Bereich kopieren  
            'wbkCSV.Sheets(1).UsedRange.Copy Destination:=wksZiel.Cells(lngLetzteZeile + 2, 1)  
            'nur die 2. Zeile kopieren  
            wbkCSV.Sheets(1).Rows("2:2").Copy Destination:=wksZiel.Cells(lngLetzteZeile + 1, 1)  
            wbkCSV.Close False
        Next
    End If
    wksZiel.Columns("A:G").EntireColumn.AutoFit  
    With wksZiel.Columns("A:G")  
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
End Sub
Mitglied: sims
sims 27.11.2014 um 16:41:47 Uhr
Goto Top
Habe jetzt noch einen anderen Code versucht aber leider schaffe ich es auch einen Wert auzulesen - wäre eine feine Sache wenn mir wer weiterhelfen könnte!

BESTEN DANK

Sub ZeilenFiltern()
Set Quelle = ThisWorkbook
Set Ziel = Workbooks.Add

Zieldatei = "D:\Auszug.xlsx" 'Pfad der Zieldatei  
ZZeile = 1 'erste Zeile der Zieltabelle  
QZeile = 1 'erste zu verarbeitende Zeile der Quelltabelle  
QSpalten = 5 'erste 5 Spalten der Quelltabelle übertragen  
QKritSpalte = "B" 'Spalte mit dem Kriterium (Timestamp)  

Zuletzt = 0 ' Startwert für Datum setzen  
With Quelle.Worksheets(1)
    'Überschriftenzeile übertragen  
    Ziel.Worksheets(1).Cells(ZZeile, "A").Resize(1, QSpalten) = .Cells(QZeile, "A").Resize(1, QSpalten).Value 'Zellen ab Spalte A übertragen  
    QZeile = QZeile + 1 'nächste Zeile der Quelldatei  
    ZZeile = ZZeile + 1 'nächste Zeile der Zieldatei  
    
    Datum = Int(.Cells(QZeile, QKritSpalte).Value) 'Datum aus aktueller Zeile der Quelldatei auslesen  
    Zeit = .Cells(QZeile, QKritSpalte).Value - Datum 'Uhrzeit aus aktueller Zeile der Quelldatei ermitteln  
    Do Until Datum = 0 'alle Datenzeilen der Quelldatei durchgehen  
        If Datum <> Zuletzt Then 'nur einen Datensatz / Tag  
            If Zeit >= 0.5 Then ' 0.5 = 12:00:00  
                Ziel.Worksheets(1).Cells(ZZeile, "A").Resize(1, QSpalten) = .Cells(QZeile, "A").Resize(1, QSpalten).Value 'Zellen ab Spalte A übertragen  
                ZZeile = ZZeile + 1 'nächste Zeile der Zieldatei  
                Zuletzt = Datum 'verarbeitetes Datum zwischenspeichern  
            End If
        End If
        QZeile = QZeile + 1 'nächste Zeile der Quelldatei  
        Datum = Int(.Cells(QZeile, QKritSpalte).Value) 'Datum aus aktueller Zeile der Quelldatei auslesen  
        Zeit = .Cells(QZeile, QKritSpalte).Value - Datum 'Uhrzeit aus aktueller Zeile der Quelldatei ermitteln  
    Loop
End With
Ziel.Worksheets(1).Columns.AutoFit 'alle Spalten der Zieldatei auf optimale Breite setzen  
Ziel.SaveAs Zieldatei 'Zieldatei speichern  
End Sub
Mitglied: colinardo
Lösung colinardo 27.11.2014, aktualisiert am 29.11.2014 um 17:57:43 Uhr
Goto Top
Moin Sims,
Sub GetHighestValuePerDay()
    'Konstanten  
    Const QUELLPFAD = "D:\TEST_DATEN.csv"  
    Const ZIELPFAD = "D:\TEST_DATEN_OUT.xlsx"  
    
    'Variablen  
    Dim wsTarget As Worksheet, wbNew As Workbook, rngDelete As Range, cell As Range, dic as Object
    
    'Objekte  
    Set dic = CreateObject("Scripting.Dictionary")  
    
    'Alerts und Screen-Refresh deaktivieren  
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    
    'Zielarbeitsblatt und Workbook für die importierten Daten  
    Set wbNew = Workbooks.Add
    Set wsTarget = wbNew.Sheets(1)
    
    'CSV mit Querytable importieren  
    With wsTarget.QueryTables.Add(Connection:="TEXT;" & QUELLPFAD, Destination:=wsTarget.Range("A1"))  
        .Name = "import"  
        .FieldNames = False
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePlatform = 1252
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileSemicolonDelimiter = True
        .Refresh BackgroundQuery:=False
        .Delete
    End With

    With wsTarget
        'nach Werten absteigend sortieren  
        .Sort.SortFields.Add Key:=Range("B:B"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal  
        With .Sort
            .SetRange Range("A:B")  
            .Header = xlNo
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
        'doppelte Tage entfernen  
        For Each cell In .Range("A1", .Range("A1").End(xlDown))  
            d = Int(cell.Value)
            If Not dic.Exists(d) Then
                dic.Add d, ""  
            Else
                If Not rngDelete Is Nothing Then
                    Set rngDelete = Union(rngDelete, cell.EntireRow)
                Else
                    Set rngDelete = cell.EntireRow
                End If
            End If
        Next
        rngDelete.Delete
        
        ' nach Datum sortieren  
        .Sort.SortFields.Clear
        .Sort.SortFields.Add Key:=Range("A:A"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal  
        With .Sort
            .SetRange Range("A:B")  
            .Header = xlNo
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
        'Spalten anpassen  
        .Range("A:B").Columns.AutoFit  
    End With
    
    'Neue Datei speichern und schließen  
    wbNew.SaveAs ZIELPFAD
    wbNew.Close
    
    'Alerts und Refresh wieder aktivieren  
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    set dic = Nothing
    MsgBox "Vorgang beendet!", vbInformation  
End Sub
Grüße Uwe
Mitglied: sims
sims 27.11.2014 um 19:22:26 Uhr
Goto Top
Besten DANK UWE für die überarbeitung.

Ich habe den Code jetzt getestet aber leider erhalte ich aus ergebnis nur eine Datei mit einer Zeil Inhalt.

Das Skript läuft durch und sagt auch"Vorgang beendet!" aber es ist nur ein wert im neuem excel file vorhanden.

vielleicht hast noch einen tipp! face-wink

Grüße
Mitglied: colinardo
colinardo 27.11.2014 aktualisiert um 19:26:18 Uhr
Goto Top
Ich dachte du wolltest nur den höchsten Wert von allen haben ?
Mitglied: sims
sims 27.11.2014 um 19:38:00 Uhr
Goto Top
achso - sorry - missverständnis!

nein, ich bäcuhte von jeden Tag den höchsten so das ich dann für jeden Tag einen Wert habe! face-wink
Mitglied: colinardo
Lösung colinardo 27.11.2014, aktualisiert am 29.11.2014 um 17:57:32 Uhr
Goto Top
ach... mein Fehler "pro Tag" überlesen. Asche auf mein Haupt. Mach dir morgen die Änderungen face-wink

Grüße Uwe

-edit- Code ist bereits oben entsprechend angepasst...
Mitglied: sims
sims 28.11.2014 um 07:11:01 Uhr
Goto Top
Hallo Uwe,
besten DANK, für die Hilfe!
Mitglied: sims
sims 29.11.2014 um 17:57:28 Uhr
Goto Top
Hat bestens funktioniert!!!

Besten DANK für die Hilfe!!!