Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1464to1468
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

csv in xlsx via Makro

csv in xlsx via Makro
05.01.2016 11:52:06
Michael
Guten Tag Zusammen,
ich muss monatlich mehr als 400 csv-Dateien in das xlsx-Format umwandeln. Manuell mit Öffnen und im xlsx-Format abspeichern klappt das hervorragend, ist aber sicherlich nicht praktikabel.
Aus dem Internet habe ich mir folgendes Makro geholt:

Sub Convert_CSV_to_XLS_Punkte()
Dim OrdnerEin As String
Dim XL As Variant, FSO As Variant, Datei As Variant
OrdnerEin = "E:\Test"
Set XL = CreateObject("Excel.Application")
Set FSO = CreateObject("Scripting.FileSystemObject")
For Each Datei In FSO.GetFolder(OrdnerEin).Files
If LCase(FSO.GetExtensionName(Datei.Name)) = "csv" Then
XL.Workbooks.Open Datei.Path
XL.ActiveWorkbook.SaveAs OrdnerEin & "\" & FSO.GetBaseName(Datei.Name) & ".xlsx", 51, , , ,  _
False
XL.ActiveWorkbook.Close False
End If
Next
XL.Quit
Set XL = Nothing
Set FSO = Nothing
End Sub

Es werden auch xlsx-Dateien erzeugt, jedoch anstelle der Zahlenwerte steht in den Zellen: 00";"0, außerdem ist die Anordnung der Spalten anders.
Wer kann mir weiterhelfen?
Vielen Dank
Michael

14
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: csv in xlsx via Makro
05.01.2016 12:00:08
Rudi
Hallo,
aus meinem Archiv:
Sub aaaaa()
Dim sFile As String, sPath As String, iFree As Integer
Dim arrCSV, arrTmp, arrXLS(), i As Long, j As Integer, n As Long
sPath = "c:\temp\"  'anpassen
sFile = Dir(sPath & "*.csv")
Application.ScreenUpdating = False
Do While Len(sFile)
iFree = FreeFile
Open sPath & sFile For Input As iFree
arrCSV = Split(Input(LOF(iFree), iFree), vbCrLf)
Close iFree
For i = 0 To UBound(arrCSV)
arrTmp = Split(arrCSV(i), ";")
n = Application.Max(n, UBound(arrTmp))
Next
ReDim arrXLS(1 To UBound(arrCSV) + 1, 1 To n + 1)
For i = 0 To UBound(arrCSV)
arrTmp = Split(arrCSV(i), ";")
For j = 0 To UBound(arrTmp)
arrXLS(i + 1, j + 1) = arrTmp(j)
Next
Next
With Workbooks.Add
.Sheets(1).Cells(1, 1).Resize(UBound(arrXLS), UBound(arrXLS, 2)) = arrXLS
.SaveAs sPath & Left(sFile, Len(sFile) - 4), xlOpenXMLWorkbook
.Close
End With
sFile = Dir
Loop
End Sub

Gruß
Rudi

Anzeige
fast!
05.01.2016 12:05:59
Michael
Hallo Rudi,
das sieht schon super aus! Leider sind noch alle Zahlenwerte in ""!
Kriegt man das noch in den Griff?
Vielen Dank
Michael

AW: fast!
05.01.2016 12:18:02
Rudi
Hallo,
evtl. mit
arrXLS(i + 1, j + 1) = replace(arrTmp(j),"""","")
Gruß
Rudi

bleibt hängen
05.01.2016 12:27:39
Michael
Hallo Rudi,
nach der Änderung bleibt das Makro mit folgende Meldung:
Laufzeitfehler 1004
Anwendungs- oder objektorientierter Fehler
an der Stelle:
.Sheets(1).Cells(1, 1).Resize(UBound(arrXLS), UBound(arrXLS, 2)) = arrXLS
hängen!
Gruß
Michael

AW: bleibt hängen
05.01.2016 12:33:42
Rudi
Hallo,
dann lade mal eine CSV hoch.
Gruß
Rudi

Anzeige
funktioniert 1a. owT
05.01.2016 12:56:00
Rudi

liegt am Dummy
05.01.2016 13:20:49
Michael
Hallo Rudi,
das hat mich echt irritiert.
Ich habe mal eine Originaldatei geöffnet und ohne Änderungen sofort wieder als csv abgespeichert.
Die Meldung, dass nicht alle Dinge in eine csv-Datei abgespeichert werden können, habe ich bestätigt!
Danach läuft auch die Originaldatei im Makro durch!!
Leider kann ich Dir so ein Original aus Gründen des Datenschutz nicht zur Verfügung stellen.
Hast Du noch eine Idee?!
Gruß
Michael

Anzeige
AW: liegt am Dummy
05.01.2016 13:48:47
Rudi
Öffne eine csv mit Notepad und anonymisiere sie.

neuer Dummy
05.01.2016 14:07:15
Michael
Hallo Rudi,
anbei ein neuer Dummy:
https://www.herber.de/bbs/user/102590.zip
Das Datum ist in der xlsx-Datei ist unwichtig, muss also nicht zwingend in eine Zahl umgewandelt werden! Lediglich die Zahlenwerte in den Auswertungstabellen sind für weitere auswertungen wichtig.
Gruß
Michael

AW: neuer Dummy
05.01.2016 15:06:29
Rudi
Hallo,
ganz schön tricky.
Sub aaaaa()
Dim sFile As String, sPath As String, iFree As Integer
Dim arrCSV, arrTmp, arrXLS(), i As Long, j As Integer, n As Long
sPath = "c:\test\1\"  'anpassen
sFile = Dir(sPath & "*.csv")
Application.ScreenUpdating = False
Do While Len(sFile)
iFree = FreeFile
Open sPath & sFile For Input As iFree
arrCSV = Split(Input(LOF(iFree), iFree), vbCrLf)
Close iFree
For i = 0 To UBound(arrCSV)
arrCSV(i) = Replace(arrCSV(i), """", "")
arrTmp = Split(arrCSV(i), ";")
n = Application.Max(n, UBound(arrTmp))
Next
ReDim arrXLS(1 To UBound(arrCSV) + 1, 1 To n + 1)
For i = 0 To UBound(arrCSV)
arrTmp = Split(arrCSV(i), ";")
For j = 0 To UBound(arrTmp)
arrXLS(i + 1, j + 1) = Replace(arrTmp(j), "=", "")
If Not arrXLS(i + 1, j + 1) Like "##.##.####" Then
If IsNumeric(arrXLS(i + 1, j + 1)) Then
arrXLS(i + 1, j + 1) = arrXLS(i + 1, j + 1) * 1
End If
End If
Next
Next
With Workbooks.Add
.Sheets(1).Cells(1, 1).Resize(UBound(arrXLS), UBound(arrXLS, 2)) = arrXLS
.SaveAs sPath & Mid(sFile, 1, Len(sFile) - 4), xlOpenXMLWorkbook
.Close
End With
sFile = Dir
Loop
End Sub
Gruß
Rudi

Anzeige
SUPER, mit kleiner Rückfrage
05.01.2016 15:52:16
Michael
Hallo Rudi,
erstmal vielen Dank für die tolle Lösung und Deine Gedult mit mir.
Läuft mit allen Dateien durch und die Ergebnisse sind alle perfekt.
Lediglich wenn im Dateinamen ein Punkt verwendet wird, dann wird bei der erzeugten Datei kein .xlsx hinzugefügt.
Kann man diese Problem im Code lösen, oder musss ich dafür sorgen, dass die Punkte im Dateinamen generell unterbunden werden.
Herzlichen Dank und Gruß
Michael

AW: SUPER, mit kleiner Rückfrage
05.01.2016 15:58:48
Rudi
Hallo,
ja, der . stört immer bei der SaveAs-Methode, da alles dahinter als Endung angesehen wird.
Einfach raus schmeißen.
.SaveAs sPath & Replace(Mid(sFile, 1, Len(sFile) - 4), ".", ""), xlOpenXMLWorkbook
Gruß
Rudi

Anzeige
PERFEKT! 1000 Dank! owT
05.01.2016 16:25:57
Michael

21 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige