Wie ich sehe hat sich noch keiner dazu gemeldet - auch verständlich: Das ist schon keine simple Frage mehr (es ist nicht mal eine Frage!!).
Wie dem auch sei, ich zeige hier mal eine Variante auf, die Gebrauch von einigen Features macht (so z.B. Power Query):
Nur damit das klar ist: ich antworte hier nicht auf den Themenersteller, sondern ich antworte hier der VBA-Community. Das Thema ist durchaus interessant, da man hier stark unterschiedliche Wege gehen kann, um schlussendlich ans gleiche Ziel zu gelangen. Der nachfolgende Weg ist vermutlich nicht gerade derjenige, den viele kennen.
'Modul: modImport
Option Explicit
Public Sub ImportCSV_Special(ByVal FilePath As String, ByVal Destination As Object)
'---------------------------------------------
Const C_VALUE_FORMAT As String = "0.00"
Const C_DATE_FORMAT As String = "m/d/yyyy"
Const C_TIME_FORMAT As String = "[$-F400]h:mm:ss AM/PM"
'---------------------------------------------
FilePath = Trim$(FilePath)
If Dir$(FilePath) = "" Then
Call MsgBox("CSV-Datei '" & FilePath & "' konnte nicht gefunden werden.", vbExclamation)
Exit Sub
End If
Dim rngDest As Excel.Range
Dim objQuery As WorkbookQuery
'destination for csv data
If Destination Is Nothing Then
Call MsgBox("Kein Zielort für Import der CSV-Datei '" & FilePath & "' vorhanden.", vbExclamation)
Exit Sub
ElseIf TypeOf Destination Is Excel.Worksheet Then
Set rngDest = Destination.Range("A1")
ElseIf TypeOf Destination Is Excel.Range Then
Set rngDest = Destination.Cells(1, 1)
Else
Call MsgBox("Der Zielort für Import der CSV-Datei '" & FilePath & "' ist ungültig.", vbExclamation)
Exit Sub
End If
'## initialize data source connections ##
'create Power Query to data (csv file)
Set objQuery = ThisWorkbook.Queries.Add("CSV-Request-" & Format$(Now, "yyyymmddhhnnss"), _
"let" & vbNewLine & _
"#""CSV-Src"" = Csv.Document(File.Contents(""" & FilePath & """),[Delimiter="";"", Columns=3, Encoding=1252, QuoteStyle=QuoteStyle.None])," & vbNewLine & _
"#""CSV-Src-T"" = Table.TransformColumnTypes(#""CSV-Src"",{{""Column1"", type text}, {""Column2"", type number}, {""Column3"", type datetime}})," & vbNewLine & _
"#""CSV-Source"" = Table.RenameColumns(#""CSV-Src-T"",{{""Column1"", ""Name""}, {""Column2"", ""Wert""}, {""Column3"", ""Datum""}})" & vbNewLine & _
"in" & vbNewLine & _
"#""CSV-Source""")
Dim objCon As WorkbookConnection
Dim pvt As Excel.PivotTable
'connect to query
Set objCon = ThisWorkbook.Connections.Add2(objQuery.Name & " - Connection", "", _
"OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=" & objQuery.Name & ";Extended Properties=""""", _
"SELECT Name, (Wert / 1000000) As Wert, Datum FROM [" & objQuery.Name & "]", XlCmdType.xlCmdSql)
With ThisWorkbook.Worksheets.Add
'create pivot table via query-connection
Set pvt = ThisWorkbook.PivotCaches.Create(xlExternal, objCon).CreatePivotTable(.Range("A1"), "CSV-Pivot")
'set pivot view
pvt.ColumnGrand = False
pvt.RowGrand = False
pvt.DisplayFieldCaptions = False
'assign pivot fields
pvt.PivotFields("Name").Orientation = XlPivotFieldOrientation.xlColumnField
pvt.PivotFields("Wert").Orientation = XlPivotFieldOrientation.xlDataField
pvt.PivotFields("Datum").Orientation = XlPivotFieldOrientation.xlRowField
'set format for pivot data field (will be copied later)
pvt.DataFields(1).NumberFormat = C_VALUE_FORMAT
Dim rngData As Excel.Range
'referencing pivot data range (including headers)
Set rngData = pvt.RowRange.Resize(ColumnSize:=pvt.RowRange.Columns.Count + pvt.ColumnRange.Columns.Count)
'clear destination first
rngDest.CurrentRegion.Clear
'copy pivot data to ...
rngData.Copy rngDest
Application.DisplayAlerts = False
'delete worksheet (incl. pivot table)
.Delete
Application.DisplayAlerts = True
End With
'delete connection to query
If Not objCon Is Nothing Then objCon.Delete
'delete query
If Not objQuery Is Nothing Then objQuery.Delete
'## alter & format output ##
rngDest.Parent.Activate
Set rngDest = rngDest.CurrentRegion
'DateTime -> Date | Time
rngDest.Columns(2).Resize(, 2).Insert xlShiftToRight
rngDest.Rows(1).Resize(, 3).Value = Array("", "Datum", "Uhrzeit")
'referencing data rows
With rngDest.Rows.Offset(1).Resize(rngDest.CurrentRegion.Rows.Count - 1)
'column: Date
.Columns(2).NumberFormat = C_DATE_FORMAT
.Columns(2).Formula = "=DATE(YEAR(RC[-1]),MONTH(RC[-1]),DAY(RC[-1]))"
.Columns(2).Value = .Columns(2).Value
'column: Time
.Columns(3).NumberFormat = C_TIME_FORMAT
.Columns(3).Formula = "=TIME(HOUR(RC[-2]),MINUTE(RC[-2]),SECOND(RC[-2]))"
.Columns(3).Value = .Columns(3).Value
'delete column: DateTime
.Columns(1).EntireColumn.Delete
.EntireColumn.AutoFit
End With
Call MsgBox("Import von '" & FilePath & "' erfolgreich abgeschlossen.", vbInformation)
End Sub
Aufgerufen wird das dann also einfach mit:
ImportCSV_Special "D:\data.csv", ThisWorkbook.Worksheets("Tabelle1").Range("A1")
Viele Grüße an die VBA Community
|