Der Helfer Franz (fcs) hat mir freundlicherweise geholfen mit einem Makro (siehe Archiv ID 1346513 - https://www.herber.de/forum/archiv/1344to1348/t1346513.htm).
Ich habe das dann noch etwas an meine Struktur anpassen müssen. Funktioniert alles super (Dank nochmals an Franz!), leider aber übernimmt das Makro im CSV-File die Werte nicht grundsätzlich mit 2 Kommastellen (die Werte sollten nach Löschen der Spalten A:R in Spalte I stehen; sie stehen vor dem Löschen in Spalte AA).
Mein Versuch, das Makro zu ergänzen scheitert...
'Format in Spalte Value auf Zahl mit 2 Kommastellen setzen
Range("I:I").Select
Selection.NumberFormat = "0.00"
Range("A1").Select
Habs auch versucht mit...
'Format in Spalte Value auf Zahl mit 2 Kommastellen setzen
With Range("I:I").Select
Selection.NumberFormat = "0.00"
End With
Range("A1").Select
die Werte mit xxx.00 werden im CSV nach wie vor nicht mit 2 Kommastellen angezeigt.
Hätte mir jemand die Lösung? Wäre super!
Viele Grüsse
Beat
Sub csv_196()
' csv_196 Makro
' Erstellt CSV-file mit Vorschlag Speicherort Desktop
Dim wks As Worksheet
Dim SrcRg As Range
Dim CurrRow As Range
Dim CurrCell As Range
Dim CurrTextStr As String
Dim ListSep As String
Dim FName As Variant, FPath As String
Dim FF As Integer
'Vorgabe-Verzeichnis der CSV-Datei
FPath = ActiveWorkbook.Path 'Verzeichnis der aktiven Arbeitsmappe
FPath = "C:\Users\" & VBA.Environ("Username") & "\Desktop" '"C:\Users\" ggf. anpassen
FPath = FPath & Application.PathSeparator
'Vorgabe-Dateiname aus Werten im Blatt uploadfile bilden
With Worksheets("Uploadfile")
.Range("A7").Calculate
FName = "Upload_DWH_" & .Range("N10").Text & "_P&L_" & .Range("N7").Text _
& .Range("N5").Text & "_" & Format(.Range("N13"), "yyyymmdd") & "-" & Format(.Range(" _
N13"), "hhmm") & ".csv"
End With
'Auswahldialog für Dateinahme anzeigen
FName = Application.GetSaveAsFilename(FPath & FName, "CSV File (*.csv), *.csv")
If FName = False Then Exit Sub
Set wks = ActiveWorkbook.Sheets("Uploadfile") 'Name ggf. anpassen
'Blatt in temproräres Blatt kopieren
wks.Copy after:=wks
Set wks = ActiveSheet
wks.Name = "UploadFile " & Format(Now, "YYYYMMDD hhmmss")
With wks
'Formeln durch Werte ersetzen
With .UsedRange
.Copy
.PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
End With
'Spalten löschen
.Range("A:R").EntireColumn.Delete shift:=xlShiftToLeft
End With
Range("A1").Select
'Format in Spalte Value auf Zahl mit 2 Kommastellen setzen
Range("I:I").Select
Selection.NumberFormat = "0.00"
Range("A1").Select
'CSV-File erstellen
ListSep = Application.International(xlListSeparator)
If Selection.Cells.Count > 1 Then
Set SrcRg = Selection
Else
Set SrcRg = ActiveSheet.UsedRange
End If
FF = FreeFile
Open FName For Output As #FF
For Each CurrRow In SrcRg.Rows
CurrTextStr = "" ' ìî
For Each CurrCell In CurrRow.Cells
CurrTextStr = CurrTextStr & CurrCell.Value & ListSep
Next
While Right(CurrTextStr, 1) = ListSep
CurrTextStr = Left(CurrTextStr, Len(CurrTextStr) - 1)
Wend
Print #FF, CurrTextStr
Next
Close #FF
'temporäre Blattkopie wieder löschen
Application.DisplayAlerts = False
wks.Delete
Application.DisplayAlerts = True
' zurück an den Ursprungsort
Sheets("Uploadfile").Select
Range("P14").Select
End Sub