Einen schönen guten Morgen in die Runde.........
zunächst vorweg, ich "bastle" mir meine VBACodes immer irgendwie so zusammen bis es passt, learning by doing.... ob das dann der "richtige" Weg ist, wage ich an der einen oder anderen Stelle sehr zu bezweiflen. Bisher ging immer alles gut, aber jetzt bin ich an einer Stelle, an der ich einfach nicht weiter komme. Vielleicht habt Ihr einen Tipp.....
Ich möchte .csv Dateien importieren (Daten aus einem SolarModul (Ertrag/Verbrauch/Fehler;........ , die Dezimazahlen sind mit Punkt geschrieben) und das fortlaufend. Das SolarModul exportiert jeweils die letzten 30 Tage.
Ich kann über einen CommandButton die CSV-Dateien importieren, die Daten werden untereinander in die Tabelle eingetragen und doppelte Datensätze werden entfernt. Die mit Punkt geschriebenen Zahlen werden nach dem Importieren mit Komma geschrieben, so dass sie auch wirklich eine Zahl sind. So weit so gut....... das funktioniert bestens.
Mein Problem ist das Datum..... es wird nicht als echtes Datum ausgegeben.
Über einen zweiten Button (kann später in den ersten integriert werden) wird das Datum nun in ein echtes Datum konvertiert und sortiert. Auch das funktioniert erst mal gut. Das Problem taucht an der Stelle auf, an der bereits konvertierte DatumAngaben in der Tabelle stehen und diese bei einer "zweiten" Konvertierung nochmal in ein Datum konvertiert werden und so falsche Daten entstehen..... zB Tage, die in der Zukunft liegen..... das ist ungünstig.......
und nun habe ich verschiedene Wege versucht, das Problem zu umgehen, aber ich komme auf keine gute/richtige Formulierung, die mich zum Ziel bringt.....
meine Ansätze waren:
Die Daten bereits beim Importieren in ein Datum konvertieren
die Datensätze ignorieren, die bereits ein echtes Datum sind
nur die Datensätze berücksichtigen, die als Text geschrieben sind
die Entscheidung Zeile für Zeile über eine LoopFunktion laufen lassen......
Habt Ihr vielleicht eine Idee oder eine Lösung?
Herzlichen Dank im Voraus!
Dagmar
Private Sub CommandButton1_Click()
Range("A10").Select
Dim strFileName As String, arrDaten, arrTmp, lngR As Long, lngLast As Long
Const cstrDelim As String = "," 'Trennzeichen
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = False
.Title = "Datei wählen"
.InitialFileName = "c:\test\*.csv" 'Pfad anpassen
If .Show = -1 Then
strFileName = .SelectedItems(1)
End If
End With
If strFileName <> "" Then
Application.ScreenUpdating = False
Open strFileName For Input As #1
arrDaten = Split(Input(LOF(1), 1), vbCrLf)
Close #1
For lngR = 1 To UBound(arrDaten)
arrTmp = Split(arrDaten(lngR), cstrDelim)
If UBound(arrTmp) > -1 Then
With ActiveSheet
lngLast = .Cells(Rows.Count, 1).End(xlUp).Row + 1
lngLast = Application.Max(lngLast, 10)
.Cells(lngLast, 1).Resize(, UBound(arrTmp) + 1) _
= Application.Transpose(Application.Transpose(arrTmp))
End With
End If
Next lngR
End If
Range("F10:H377").Select
Selection.NumberFormat = "0.00"
Columns("A:O").Select
With Selection
.HorizontalAlignment = xlGeneral
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlCenter
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("A10").SpecialCells(xlLastCell)).Select
Selection.RemoveDuplicates Columns:=2, Header:=xlYes
Range("A9").Select
End Sub
Private Sub CommandButton2_Click() Range("B11:B400").Select Selection.TextToColumns Destination:=Range("B11"), DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _ Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _ :=Array(1, 4), TrailingMinusNumbers:=True Range("B11:B400").Select ActiveWorkbook.Worksheets("Tabelle1").Sort.SortFields.Clear ActiveWorkbook.Worksheets("Tabelle1").Sort.SortFields.Add2 Key:=Range("B11") _ , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal With ActiveWorkbook.Worksheets("Tabelle1").Sort .SetRange Range("A10:O400") .Header = xlNo .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With Range("A9").Select End Sub
|