*csv Inport mit Auswahl und Einstellungen
22.10.2019 11:18:40
Nico
Ich habe ein Problem bei den ich nicht weiter komme und hoffe ihr könnt mir Helfen!
Ich bekomme Täglich einen Datenbankauszug als CSV Datei der besteht aus 5 Spalten un 75.000 Zeilen.
Da diese Datei jeweils eine Historie von 7 Tagen enthält, muss ich sie in Excel importieren und nach den Tageswerten filtern damit keine Doppelungen Entstehen! Das Filtern und Zusammenstellen habe ich bereits in einer Datei Realisiert!
Jedoch beim Import komme ich nicht Weiter!
Als erstes müsste ich aus einem Ordner die zu importierende Datei auswählen können.
Da in den Importeinstellungen 2 spalten als Ganze Zahl erkannt werden muss ich im Abfrage Editor die Spalten Formate gemäß dem Beispiel Anpassen:
Dezimalzahl; Dezimalzahl; Text; Datum/Uhrzeit; Dezimalzahl
1003713462; 53279390; Comm_03:5484_BHK_xxx1_xx40_EM_ZEWANL; 2019.09.24 04:44:22.000; 1544180,02
1003713462; 53279390; Comm_03:5484_BHK_xxx1_xx40_EM_ZEWANL; 2019.09.24 05:44:22.000; 15441900,54
1003713462; 53279390; Comm_03:5484_BHK_xxx1_xx40_EM_ZEWANL; 2019.09.24 06:44:21.000; 1544200,69
1003713462; 53279390; Comm_03:5484_BHK_xxx1_xx40_EM_ZEWANL; 2019.09.24 07:44:21.000; 1544200,58
Und die Datei Schlussendlich in das Vorhandene Tabellenblatt Import einfügen
Im Netz habe ich nach langer suche eine Ähnliche Aufgabenstellung inkl Lösung als VBA Code Gefunden.
VBA Code:
Modul:
Sub Import()
Dim var As Variant
Dim retval As Integer
Dim intTabelleVorhanden As Integer
Dim filename As Variant
Dim iCounter As Integer
Dim strConnection As String
intTabelleVorhanden = 0
'Dateiauswahl
var = Application.GetOpenFilename( _
FileFilter:="Comma-Separated Values (CSV) - Datei (*.csv), *.csv", _
Title:="CSV-Datei öffnen")
If var = "" Or var = False Then Exit Sub
'Dateinamen extrahieren
filename = Dir(var)
'Neues Tabellenblatt erzeugen
Worksheets.Add.Move after:=Worksheets(Worksheets.Count)
For iCounter = 1 To Worksheets.Count - 1
If Worksheets(iCounter).Name = filename Then
intTabelleVorhanden = 1
End If
Next iCounter
'Neues Tabellenblatt mit CSV-Dateinamen benennen
If intTabelleVorhanden = 0 Then
ThisWorkbook.Worksheets(Worksheets.Count).Name = filename
Else
retval = MsgBox("Tabelle " & filename & " existiert bereits." & vbCrLf & _
"Überschreiben?", vbYesNo + vbQuestion, "Information")
If retval = vbYes Then
ThisWorkbook.Worksheets(Worksheets.Count).Delete
ThisWorkbook.Worksheets(Worksheets.Count).Name = filename
Else
ThisWorkbook.Worksheets(Worksheets.Count).Delete
Exit Sub
End If
End If
strConnection = "Text;" & var
'Dateiimport in neues Tabellenblatt
With ThisWorkbook.Worksheets(Worksheets.Count).QueryTables.Add(Connection:= _
strConnection, _
Destination:=ThisWorkbook.Worksheets(Worksheets.Count).Range("A1"))
.Name = "protokoll"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = xlWindows
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = True
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(2, 1, 1, 1, 1, 1, 1)
.Refresh BackgroundQuery:=False
End With
'Überschrift fixieren
Range("A2").Select
ActiveWindow.FreezePanes = True
'Autofilter setzen
Selection.AutoFilter
ActiveWindow.ScrollColumn = 1
Range("A1").Select
Rows("1:1").Select
With Selection.Interior
.ColorIndex = 8
.Pattern = xlSolid
End With
Schriftart_fest
End Sub
Sub Schriftart_fest()
'Schriftart mit fester Weite einstellen wg. der Störtexte
'und alle Spalten optimal ausrichten
Cells.Select
With Selection.Font
.Name = "Courier New"
.Size = 10
End With
Cells.EntireColumn.AutoFit
Range("A1").Select
Einrichten
End Sub
Sub Einrichten()
frmStatus.Show
frmStatus.lblStatus.Caption = "CSV-Import läuft, bitte warten Sie..."
DoEvents
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.787401575)
.RightMargin = Application.InchesToPoints(0.787401575)
.TopMargin = Application.InchesToPoints(0.984251969)
.BottomMargin = Application.InchesToPoints(0.984251969)
.HeaderMargin = Application.InchesToPoints(0.4921259845)
.FooterMargin = Application.InchesToPoints(0.4921259845)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = False
End With
Unload frmStatus
End Sub
Und der ComandButton:
Private Sub CommandButton1_Click()
CSV.Import
End Sub
Nach einigen Versuchen muss ich eingestehen, dass meine VBA Kenntnisse Leider nicht ausreichen um diesen Anzupassen!
Ich benötige keinerlei Kopf,- und Fußzeilen und auch keine Überschriften in der Tabelle!
Ich hoffe ihr könnt mir ein wenig weiterhelfen!
Vielen Dank Nico!
PS eine Musterdatei kann ich leider nicht anhängen, da der Upload nicht Funktioniert!!