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, 883 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 ..
Neuester Wissensbeitrag
Humor (lol)

Linkliste für Adventskalender

(3)

Information von nikoatit zum Thema Humor (lol) ...

Ähnliche Inhalte
Microsoft Office
gelöst Excel VBA Wert hochzählen (1)

Frage von Florian86 zum Thema Microsoft Office ...

VB for Applications
Excel VBA XML-Nodes auslesen (4)

Frage von chef1568 zum Thema VB for Applications ...

VB for Applications
gelöst VBA: Wert von einer Website (pdf-Dokument) auslesen und in Excel kopieren (16)

Frage von Stern123 zum Thema VB for Applications ...

Batch & Shell
gelöst Mit Batchdatei Informationen auslesen und diese strukturiert in Excel ausgeben (9)

Frage von Flodsche zum Thema Batch & Shell ...

Heiß diskutierte Inhalte
Windows Server
DHCP Server switchen (25)

Frage von M.Marz zum Thema Windows Server ...

SAN, NAS, DAS
gelöst HP-Proliant Microserver Betriebssystem (14)

Frage von Yannosch zum Thema SAN, NAS, DAS ...

Grafikkarten & Monitore
Win 10 Grafikkarte Crash von Software? (13)

Frage von Marabunta zum Thema Grafikkarten & Monitore ...

Windows 7
Verteillösung für IT-Raum benötigt (12)

Frage von TheM-Man zum Thema Windows 7 ...