Top-Themen

AppleEntwicklungHardwareInternetLinuxMicrosoftMultimediaNetzwerkeOff TopicSicherheitSonstige SystemeVirtualisierungWeiterbildungZusammenarbeit

Aktuelle Themen

Administrator.de FeedbackApache ServerAppleAssemblerAudioAusbildungAuslandBackupBasicBatch & ShellBenchmarksBibliotheken & ToolkitsBlogsCloud-DiensteClusterCMSCPU, RAM, MainboardsCSSC und C++DatenbankenDatenschutzDebianDigitiales FernsehenDNSDrucker und ScannerDSL, VDSLE-BooksE-BusinessE-MailEntwicklungErkennung und -AbwehrExchange ServerFestplatten, SSD, RaidFirewallFlatratesGoogle AndroidGrafikGrafikkarten & MonitoreGroupwareHardwareHosting & HousingHTMLHumor (lol)Hyper-VIconsIDE & EditorenInformationsdiensteInstallationInstant MessagingInternetInternet DomäneniOSISDN & AnaloganschlüsseiTunesJavaJavaScriptKiXtartKVMLAN, WAN, WirelessLinuxLinux DesktopLinux NetzwerkLinux ToolsLinux UserverwaltungLizenzierungMac OS XMicrosoftMicrosoft OfficeMikroTik RouterOSMonitoringMultimediaMultimedia & ZubehörNetzwerkeNetzwerkgrundlagenNetzwerkmanagementNetzwerkprotokolleNotebook & ZubehörNovell NetwareOff TopicOpenOffice, LibreOfficeOutlook & MailPapierkorbPascal und DelphiPeripheriegerätePerlPHPPythonRechtliche FragenRedHat, CentOS, FedoraRouter & RoutingSambaSAN, NAS, DASSchriftartenSchulung & TrainingSEOServerServer-HardwareSicherheitSicherheits-ToolsSicherheitsgrundlagenSolarisSonstige SystemeSoziale NetzwerkeSpeicherkartenStudentenjobs & PraktikumSuche ProjektpartnerSuseSwitche und HubsTipps & TricksTK-Netze & GeräteUbuntuUMTS, EDGE & GPRSUtilitiesVB for ApplicationsVerschlüsselung & ZertifikateVideo & StreamingViren und TrojanerVirtualisierungVisual StudioVmwareVoice over IPWebbrowserWebentwicklungWeiterbildungWindows 7Windows 8Windows 10Windows InstallationWindows MobileWindows NetzwerkWindows ServerWindows SystemdateienWindows ToolsWindows UpdateWindows UserverwaltungWindows VistaWindows XPXenserverXMLZusammenarbeit
GELÖST

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

Frage Microsoft Microsoft Office

Mitglied: sims

sims (Level 1) - Jetzt verbinden

27.11.2014 um 09:22 Uhr, 925 Aufrufe, 10 Kommentare, 1 Danke

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!
Mitglied: sims
27.11.2014, aktualisiert um 12:34 Uhr
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:

01.
Sub CSV_Import() 
02.
    Dim vntaDateien As Variant 
03.
    Dim lngI As Long 
04.
    Dim lngLetzteZeile As Long 
05.
    Dim wbkCSV As Workbook 
06.
    Dim wksZiel As Worksheet 
07.
    Dim rOut As Range 
08.
    Set rOut = Range("A1") 
09.
    lngLetzteZeile = 1 
10.
    With rOut.Range("A1:G1").Resize(rOut.Worksheet.Rows.Count - rOut.Row + 1) 
11.
        .ClearContents 
12.
        .Rows(1).Value = Split("Date,Time,Durchfluss1,Durchfluss2,lt101 cm,lt102 cm,tt101 C", ",") 
13.
    End With 
14.
    lngLetzteZeile = 1 
15.
    vntaDateien = Application.GetOpenFilename _ 
16.
    ("csv-Dateien (*.csv), *.csv", MultiSelect:=True) 
17.
    If IsArray(vntaDateien) Then 
18.
        Set wksZiel = ThisWorkbook.Sheets(1) 
19.
        For lngI = 1 To UBound(vntaDateien) 
20.
            lngLetzteZeile = wksZiel.UsedRange.Rows.Count 
21.
            lngLetzteZeile = ActiveSheet.Cells(1048576, 1).End(xlUp).Row 
22.
            Set wbkCSV = Workbooks.Open(vntaDateien(lngI), local:=True) 
23.
            'sortieren 
24.
            wbkCSV.Worksheets(1).Sort.SortFields.Clear 
25.
            wbkCSV.Worksheets(1).Sort.SortFields.Add Key:=Range("C2:C1048576"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal 
26.
            wbkCSV.Worksheets(1).Sort.SortFields.Add Key:=Range("D2:D1048576"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal 
27.
            With wbkCSV.Worksheets(1).Sort 
28.
                .SetRange Range("A1:G1048576") 
29.
                .Header = xlYes 
30.
                .MatchCase = False 
31.
                .Orientation = xlTopToBottom 
32.
                .Apply 
33.
            End With 
34.
            'Zeilen 3 bis Ende löschen 
35.
            wbkCSV.Worksheets(1).Rows("3:1048576").Delete shift:=xlUp 
36.
            'Dateiname kopieren 
37.
            'wksZiel.Cells(lngLetzteZeile + 1, 1) = vntaDateien(lngI) 
38.
            'Bereich kopieren 
39.
            'wbkCSV.Sheets(1).UsedRange.Copy Destination:=wksZiel.Cells(lngLetzteZeile + 2, 1) 
40.
            'nur die 2. Zeile kopieren 
41.
            wbkCSV.Sheets(1).Rows("2:2").Copy Destination:=wksZiel.Cells(lngLetzteZeile + 1, 1) 
42.
            wbkCSV.Close False 
43.
        Next 
44.
    End If 
45.
    wksZiel.Columns("A:G").EntireColumn.AutoFit 
46.
    With wksZiel.Columns("A:G") 
47.
        .HorizontalAlignment = xlCenter 
48.
        .VerticalAlignment = xlCenter 
49.
        .WrapText = False 
50.
        .Orientation = 0 
51.
        .AddIndent = False 
52.
        .IndentLevel = 0 
53.
        .ShrinkToFit = False 
54.
        .ReadingOrder = xlContext 
55.
        .MergeCells = False 
56.
    End With 
57.
End Sub
Bitte warten ..
Mitglied: sims
27.11.2014 um 16:41 Uhr
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

01.
Sub ZeilenFiltern() 
02.
Set Quelle = ThisWorkbook 
03.
Set Ziel = Workbooks.Add 
04.
 
05.
Zieldatei = "D:\Auszug.xlsx" 'Pfad der Zieldatei 
06.
ZZeile = 1 'erste Zeile der Zieltabelle 
07.
QZeile = 1 'erste zu verarbeitende Zeile der Quelltabelle 
08.
QSpalten = 5 'erste 5 Spalten der Quelltabelle übertragen 
09.
QKritSpalte = "B" 'Spalte mit dem Kriterium (Timestamp) 
10.
 
11.
Zuletzt = 0 ' Startwert für Datum setzen 
12.
With Quelle.Worksheets(1) 
13.
    'Überschriftenzeile übertragen 
14.
    Ziel.Worksheets(1).Cells(ZZeile, "A").Resize(1, QSpalten) = .Cells(QZeile, "A").Resize(1, QSpalten).Value 'Zellen ab Spalte A übertragen 
15.
    QZeile = QZeile + 1 'nächste Zeile der Quelldatei 
16.
    ZZeile = ZZeile + 1 'nächste Zeile der Zieldatei 
17.
     
18.
    Datum = Int(.Cells(QZeile, QKritSpalte).Value) 'Datum aus aktueller Zeile der Quelldatei auslesen 
19.
    Zeit = .Cells(QZeile, QKritSpalte).Value - Datum 'Uhrzeit aus aktueller Zeile der Quelldatei ermitteln 
20.
    Do Until Datum = 0 'alle Datenzeilen der Quelldatei durchgehen 
21.
        If Datum <> Zuletzt Then 'nur einen Datensatz / Tag 
22.
            If Zeit >= 0.5 Then ' 0.5 = 12:00:00 
23.
                Ziel.Worksheets(1).Cells(ZZeile, "A").Resize(1, QSpalten) = .Cells(QZeile, "A").Resize(1, QSpalten).Value 'Zellen ab Spalte A übertragen 
24.
                ZZeile = ZZeile + 1 'nächste Zeile der Zieldatei 
25.
                Zuletzt = Datum 'verarbeitetes Datum zwischenspeichern 
26.
            End If 
27.
        End If 
28.
        QZeile = QZeile + 1 'nächste Zeile der Quelldatei 
29.
        Datum = Int(.Cells(QZeile, QKritSpalte).Value) 'Datum aus aktueller Zeile der Quelldatei auslesen 
30.
        Zeit = .Cells(QZeile, QKritSpalte).Value - Datum 'Uhrzeit aus aktueller Zeile der Quelldatei ermitteln 
31.
    Loop 
32.
End With 
33.
Ziel.Worksheets(1).Columns.AutoFit 'alle Spalten der Zieldatei auf optimale Breite setzen 
34.
Ziel.SaveAs Zieldatei 'Zieldatei speichern 
35.
End Sub
Bitte warten ..
Mitglied: colinardo
LÖSUNG 27.11.2014, aktualisiert 29.11.2014
Moin Sims,
01.
Sub GetHighestValuePerDay() 
02.
    'Konstanten 
03.
    Const QUELLPFAD = "D:\TEST_DATEN.csv" 
04.
    Const ZIELPFAD = "D:\TEST_DATEN_OUT.xlsx" 
05.
     
06.
    'Variablen 
07.
    Dim wsTarget As Worksheet, wbNew As Workbook, rngDelete As Range, cell As Range, dic as Object 
08.
     
09.
    'Objekte 
10.
    Set dic = CreateObject("Scripting.Dictionary") 
11.
     
12.
    'Alerts und Screen-Refresh deaktivieren 
13.
    Application.DisplayAlerts = False 
14.
    Application.ScreenUpdating = False 
15.
     
16.
    'Zielarbeitsblatt und Workbook für die importierten Daten 
17.
    Set wbNew = Workbooks.Add 
18.
    Set wsTarget = wbNew.Sheets(1) 
19.
     
20.
    'CSV mit Querytable importieren 
21.
    With wsTarget.QueryTables.Add(Connection:="TEXT;" & QUELLPFAD, Destination:=wsTarget.Range("A1")) 
22.
        .Name = "import" 
23.
        .FieldNames = False 
24.
        .AdjustColumnWidth = True 
25.
        .RefreshPeriod = 0 
26.
        .TextFilePlatform = 1252 
27.
        .TextFileStartRow = 1 
28.
        .TextFileParseType = xlDelimited 
29.
        .TextFileTextQualifier = xlTextQualifierDoubleQuote 
30.
        .TextFileSemicolonDelimiter = True 
31.
        .Refresh BackgroundQuery:=False 
32.
        .Delete 
33.
    End With 
34.
 
35.
    With wsTarget 
36.
        'nach Werten absteigend sortieren 
37.
        .Sort.SortFields.Add Key:=Range("B:B"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal 
38.
        With .Sort 
39.
            .SetRange Range("A:B") 
40.
            .Header = xlNo 
41.
            .MatchCase = False 
42.
            .Orientation = xlTopToBottom 
43.
            .SortMethod = xlPinYin 
44.
            .Apply 
45.
        End With 
46.
        'doppelte Tage entfernen 
47.
        For Each cell In .Range("A1", .Range("A1").End(xlDown)) 
48.
            d = Int(cell.Value) 
49.
            If Not dic.Exists(d) Then 
50.
                dic.Add d, "" 
51.
            Else 
52.
                If Not rngDelete Is Nothing Then 
53.
                    Set rngDelete = Union(rngDelete, cell.EntireRow) 
54.
                Else 
55.
                    Set rngDelete = cell.EntireRow 
56.
                End If 
57.
            End If 
58.
        Next 
59.
        rngDelete.Delete 
60.
         
61.
        ' nach Datum sortieren 
62.
        .Sort.SortFields.Clear 
63.
        .Sort.SortFields.Add Key:=Range("A:A"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 
64.
        With .Sort 
65.
            .SetRange Range("A:B") 
66.
            .Header = xlNo 
67.
            .MatchCase = False 
68.
            .Orientation = xlTopToBottom 
69.
            .SortMethod = xlPinYin 
70.
            .Apply 
71.
        End With 
72.
        'Spalten anpassen 
73.
        .Range("A:B").Columns.AutoFit 
74.
    End With 
75.
     
76.
    'Neue Datei speichern und schließen 
77.
    wbNew.SaveAs ZIELPFAD 
78.
    wbNew.Close 
79.
     
80.
    'Alerts und Refresh wieder aktivieren 
81.
    Application.DisplayAlerts = True 
82.
    Application.ScreenUpdating = True 
83.
    set dic = Nothing 
84.
    MsgBox "Vorgang beendet!", vbInformation 
85.
End Sub
Grüße Uwe
Bitte warten ..
Mitglied: sims
27.11.2014 um 19:22 Uhr
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!

Grüße
Bitte warten ..
Mitglied: colinardo
27.11.2014, aktualisiert um 19:26 Uhr
Ich dachte du wolltest nur den höchsten Wert von allen haben ?
Bitte warten ..
Mitglied: sims
27.11.2014 um 19:38 Uhr
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!
Bitte warten ..
Mitglied: colinardo
LÖSUNG 27.11.2014, aktualisiert 29.11.2014
ach... mein Fehler "pro Tag" überlesen. Asche auf mein Haupt. Mach dir morgen die Änderungen

Grüße Uwe

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

Besten DANK für die Hilfe!!!
Bitte warten ..
Ähnliche Inhalte
Microsoft Office
gelöst Excel VBA Datein auslesen (8)

Frage von schwalbepilot zum Thema Microsoft Office ...

Microsoft Office
gelöst Excel oder google Sheets automatisch aktualisieren bei neuen Werten? (14)

Frage von Stoffn zum Thema Microsoft Office ...

Microsoft Office
gelöst Excel-Werte eingeben und in neue Tabelle schreiben (9)

Frage von werner1966 zum Thema Microsoft Office ...

Batch & Shell
gelöst Powershell INI Tags auslesen (2)

Frage von H41mSh1C0R zum Thema Batch & Shell ...

Neue Wissensbeiträge
Windows Server

Umstellung SHA 1 auf SHA 2 - Migration der CA von CSP auf KSP

Tipp von Badger zum Thema Windows Server ...

Windows 10

Quato DTP94 unter Windows 10 x64 installieren und verwenden

Anleitung von anteNope zum Thema Windows 10 ...

Windows 10

Win10 1703 und Nutzerkennwörter bei Ersteinrichtung - erstaunliche Erkenntnis

(15)

Erfahrungsbericht von DerWoWusste zum Thema Windows 10 ...

Heiß diskutierte Inhalte
Festplatten, SSD, Raid
gelöst Raid-Controller (Areca) Datenverlust trotz R5 (16)

Frage von sebastian2608 zum Thema Festplatten, SSD, Raid ...

Webentwicklung
Aktuellen Mitarbeiter auf Homepage anzeigen (13)

Frage von alemanne21 zum Thema Webentwicklung ...

Server-Hardware
HP ProLiant DL380 G7, POST Error: 1785-Drive Array not Configured (9)

Frage von Paderman zum Thema Server-Hardware ...

Microsoft Office
gelöst Office 365 Pro Domäne einrichten OHNE Webseite (9)

Frage von thklemm zum Thema Microsoft Office ...