Export von csv-Daten, Datenformat

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Servus Heli,

das Problem ist also bekannt - naja, das macht mich nicht fröhlicher...

Falls es irgendwie hilft und Du Zeit noch Lust hast (!!!), hierzu vielleicht was zu sagen - nachfolgend die komplette Prozedur für den Import der Daten. Das Problem tritt schon dort auf / vor dem Export (CopyData wird in einer anderen Prozedur aufgerufen, welche alle xlsx-Dateien eines Verzeichnisses abgrast - läuft also mehrfach nacheinander).

Hier noch nicht berücksichtigt ist Dein Vorschlag, das Import-Blatt als Text zu formatieren. Ich habe das allerdings vor dem Import auch mal manuell gemacht, ohne Änderung im Ergebnis. Hätte aber funktionieren müssen, weil der Code unten am Format des Blattes nichts ändert, richtig?

Sub CopyData(FullName As String, MitKopfzeile As Boolean, z As Integer)
Dim wbkImp As Workbook, wbkDst As Workbook
Dim wksImp As Worksheet, wksDst As Worksheet
Dim fRow As Integer
Dim lRow As Long, lCol As Integer
Dim wbk As Workbook
Dim aData()
Dim i As Variant

On Error GoTo ErrorHandler
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With

If MitKopfzeile Then '1. Durchlauf mit Kopfzeilen, dann ohne
fRow = IIf(z = 0, 1, 2)
Else 'Keine Kopfzeile vorhanden, also immer ab 1. Zeile
fRow = 1
End If

'Quelldatei öffnen und Daten in Array kopieren
Set wbkDst = ActiveWorkbook
Set wksDst = ActiveSheet
Workbooks.Open FileName:=FullName
Set wbkImp = ActiveWorkbook
Set wksImp = wbkImp.Sheets(1)
lRow = LastRowAll(wksImp)
lCol = LastColAll(wksImp)
aData = wksImp.Range(Cells(fRow, 1), Cells(lRow, lCol))

'In die Zieldatei schreiben
lRow = LastRowAll(wksDst) + Abs(CInt(z > 0))

'Die Einrichtung ergänzen (im Journal nicht enthalten, nur im Blattnamen an 8.Stelle)
'1xlige Eintragung in der ersten Journalzeile der jeweiligen Einrichtung
wksDst.Range("A" & lRow).Resize(UBound(aData), lCol) = aData()
wksDst.Range("A" & lRow).Resize(UBound(aData)).Value = Right(Left(wksImp.Name, 13), 5)

wbkImp.Close
Set wbkImp = Nothing

ErrorHandler:
If Not wbk Is Nothing Then
Workbooks(wbkImp).Close
End If
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With
End Sub

Function LastRowAll(Wks As Worksheet)
If WorksheetFunction.CountA(Wks.Cells) = 0 Then
LastRowAll = 1
Else
LastRowAll = Wks.Cells.Find(what:="*", _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
End If
End Function

Function LastColAll(Wks As Worksheet)
If WorksheetFunction.CountA(Wks.Cells) = 0 Then
LastColAll = 1
Else
LastColAll = Wks.Cells.Find(what:="*", _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column
End If
End Function

Hey Max,

hab durch getestet.

Zu Thorsten's Anmerkung unten - ja, vielleicht umständlich von mir, gebe ich zu.

ich hab die Formatierung jetzt geprüft, leider ohne Erfolgt:

Nach dem Import kommt auf dem Blatt Import das Standardformat an. Das habe ich am Ende Dieser Import-Prozedur geändert wie folgt:
Sheets("Import").Columns("E:F").NumberFormat = "0"
@Thorsten - wenn ich auf Textformat stelle, dann habe ich sofort diese wissenschaftliche Formatierung mit dem E
Anschließend diese Daten auf das Blatt Export kopieren und daran anschließend das Blatt Export als csv speichern.
Hat nix gebracht..

Ergo die Formatumstellung im Import wieder gelöscht und stattdessen am Ende der Kopier-Prozedur das Format auf dem Blatt Export geändert:
Sheets("Export").Columns("I").NumberFormat = "0"
(hier nur eine der beiden vom Blatt Import kopierten Spalten E+F = die Spalte, auf die es ankommt!)
anschließend das Blatt Export als csv speichern.
Hat nix gebracht..

Ergo auch diese Formatumstellung wieder gelöscht. Der jetzige (unveränderte) Code:

Sub Export()
'.....hier wird per Schleife und unter diversen Bedingungen alles Relevante vom Blatt Import runter kopiert auf das Blatt Export - meines Erachtens nicht relevant für's Problem
'.....Die Formatänderung an dieser Stelle (vor dem Speichern) brachte nichts, wieder gelöscht
Call SaveAsCSV
End Sub

Wäre es noch irgendwo möglich, in der folgenden Speicherung für das richtige Format zu sorgen?:

Sub SaveAsCSV()
Dim DstFileName As String, DstPfad As String
Dim Delimiter As String
Dim strZe As String
Dim lRow As Long, lCol As Integer
Dim Ze As Long, Sp As Integer
Dim ff As Integer

Dim Text As Range
Dim rngZelle As Range
Set Text = Sheets("Export").Range("G2:G" & Cells(Rows.Count, 7).End(xlUp).Row + 1)

'Sicherheitshalber im Buchungstext (Spalte G) alle Semikolons durch Kommata ersetzen
For Each rngZelle In Text
rngZelle.Value = Replace(rngZelle.Value, ";", ",")
Next rngZelle

Sheets("Export").Columns("I").NumberFormat = "0"

On Error GoTo ErrorHandler
DstPfad = Sheets("Bearbeitungshinweise").Range("G54")
DstFileName = "Datenaustausch_GebMan.csv"
Delimiter = ";"
With Sheets("Export")
lRow = .Cells.Find(what:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
lCol = .Cells.Find(what:="*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
ff = FreeFile
Open Replace(DstPfad & "\" & DstFileName, "\\", "\") For Output As #ff
'Zeile für Zeile lesen und schreiben ...
For Ze = 1 To lRow
For Sp = 1 To lCol - 1
strZe = strZe & .Cells(Ze, Sp) & Delimiter
Next Sp
strZe = strZe & .Cells(Ze, Sp)
Print #ff, strZe
strZe = ""
Next Ze

End With

ErrorHandler:
If Err.Number > 0 Then MsgBox "Fehler Nr. " & Err.Number & vbCrLf _
& Err.Description, vbCritical + vbOKOnly, "Das ging schief ..."
If ff > 0 Then Close #ff

MsgBox "Fertig"

'zuletzt alle zeilen löschen außer Überschrift
Sheets("Export").Rows("2:65536").ClearContents

End Sub

Beliebteste Forumthreads (12 Monate)

Export von csv-Daten, Datenformat

17 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

17
Beiträge zum Forumthread

Beiträge zu diesem Forumthread