Konsolidierung von CSV und Excel Dateien
20.06.2019 10:40:39
CSV
ich möchte Daten aus einer variablen Anzahl von gleich aufgebauten Vorgängertabellen (viertelstündliche Werte für 24 Stunden über 7 Spalten) in Excel konsolidieren. Diese werden uns täglich von unserem Energieversorger per Mail zugesandt und müssen von uns vorübergehend mit Excel "aufgehübscht" werden, bis unsere Profisoftware einsatzbereit ist.
Mit dem unten stehenden Code funktioniert es für XLSX-Daten problemlos. Das Ausgangsformat ist aber leider CSV. Hier bekomme ich aber eine Fehlermeldung "Fehler 13/ Typen unverträglich". Kann mir hier jemand helfen, wie ich den Code anpassen muss, damit das auch für CSV funktioniert?
Sub Zusammenführen()
Dim i As Long
Dim sPfad As String
Dim sDatei As String
Dim vFileToOpen As Variant
Dim lngLZ As Long
Dim blnÜberschrift As Boolean
Dim iCalc As Integer
'vFileToOpen = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", , , , True)
vFileToOpen = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*, CSV (*.csv*), *. _
cvs*", , , , True)
'vFileToOpen = Application.GetOpenFilename("CSV (*.csv*), *.cvs*", , , , True)
If Not IsArray(vFileToOpen) Then Exit Sub
iCalc = Application.Calculation
On Error GoTo ENDE:
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
' löschen Altdaten Anfang
Cells.Select
Selection.ClearContents
Range("A1").Select
' löschen Altdaten Ende
For i = 1 To UBound(vFileToOpen)
sDatei = Dir(vFileToOpen(i))
sPfad = Left(vFileToOpen(i), InStr(vFileToOpen(i), sDatei) - 1)
With Tabelle1.Range("A1")
.Formula = "=LOOKUP(2,1/('" & sPfad & "[" & sDatei & "]Tabelle1'!$A:$A""""),ROW('" _
_
_
& sPfad & "\[" & sDatei & "]Tabelle1'!$A:$A))"
lngLZ = .Value
End With
With Tabelle1
If blnÜberschrift Then
.Cells(.Rows.Count, 1).End(xlUp).Offset(1).Resize(lngLZ - 1, 7).Formula = _
"='" & sPfad & "[" & sDatei & "]Tabelle1'!A2"
Else
blnÜberschrift = True
.Cells(.Rows.Count, 1).End(xlUp).Offset(1).Resize(lngLZ, 7).Formula = _
"='" & sPfad & "[" & sDatei & "]Tabelle1'!A1"
End If
End With
Call StatusBalken(Int((i / UBound(vFileToOpen)) * 100))
Next
With Tabelle1.UsedRange
.Copy
.PasteSpecial xlPasteValues
.Rows(1).Delete
End With
ENDE:
Application.EnableEvents = True
Application.Calculation = iCalc
Application.ScreenUpdating = True
If Err Then MsgBox Err.Description, , "Fehler: " & Err
End Sub
Sub StatusBalken(ProzentSatz) ''ProzentSatz = Int((i / 10000) * 100)
Dim Mess, Z, Rest
Static oldStatusBar As Integer
Static blnInit As Boolean
If Not blnInit Then
oldStatusBar = Application.DisplayStatusBar
Application.DisplayStatusBar = True
End If
Mess = ""
For Z = 1 To ProzentSatz
Mess = Mess & ChrW(Val("&H25A0"))
Next Z
Rest = 100 - ProzentSatz
For Z = 1 To Rest
Mess = Mess & ChrW(Val("&H25A1"))
Next Z
Application.StatusBar = Mess & " " & ProzentSatz & "%"
If Rest
Application.StatusBar = False
Application.DisplayStatusBar = oldStatusBar
End If
End Sub