Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1388to1392
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 Import, bestimmter Datenbereich

CSV Import, bestimmter Datenbereich
23.10.2014 10:11:01
andthen
Hallo zusammen,
ich füge derzeit CSV - Dateien über folgendes Makro fortlaufend in meine Excel Tabelle ein :
Sub CsvMitSemikolonDelimiterInSheetEinfuegen()
Dim wksN As Excel.Worksheet
Dim qtbN As Excel.QueryTable
Dim vntPathAndFileName As Variant
Dim lngLetzteZeileSpalteA As Long
vntPathAndFileName = Application.GetOpenFilename( _
FileFilter:="csv Files (*.csv), *.csv", _
Title:="Meine Dateien ", _
MultiSelect:=False)
If VarType(vntPathAndFileName) = vbBoolean Then
MsgBox "Abgebrochen!"
Exit Sub
End If
Set wksN = ThisWorkbook.Worksheets("Basisdaten")
lngLetzteZeileSpalteA = wksN.Cells(wksN.Rows.Count, 1).End(xlUp).Row
Set qtbN = wksN.QueryTables.Add("TEXT;" & vntPathAndFileName, wksN.Cells(lngLetzteZeileSpalteA  _
_
_
_
+ 1, 1))
qtbN.FieldNames = True
qtbN.RowNumbers = False
qtbN.FillAdjacentFormulas = False
qtbN.PreserveFormatting = True
qtbN.RefreshOnFileOpen = False
qtbN.RefreshStyle = xlOverwriteCells
qtbN.SaveData = True
qtbN.AdjustColumnWidth = False
qtbN.RefreshPeriod = 0
qtbN.TextFilePromptOnRefresh = False
qtbN.TextFilePlatform = xlWindows
qtbN.TextFileStartRow = 1
qtbN.TextFileParseType = xlDelimited
qtbN.TextFileTextQualifier = xlTextQualifierNone
qtbN.TextFileTabDelimiter = False
qtbN.TextFileSemicolonDelimiter = True
qtbN.TextFileCommaDelimiter = False
qtbN.TextFileSpaceDelimiter = False
qtbN.TextFileSemicolonDelimiter = True
qtbN.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
qtbN.Refresh BackgroundQuery:=False
qtbN.Delete
End Sub
Zur Weiterverabeitung kann ich aber lediglich einen Teil der CSV - Datei benutzen.
Ich müsste meinen Code so erweitern, dass die CSV - Datei erst ab Zeile 7, bis zur nächsten leeren Zeile kopiert und eingefügt wird.
Ich hoffe ihr könnt mir weiterhelfen und bedanke mich im Voraus!
Mit freundlichen Grüßen
andthen

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: CSV Import, bestimmter Datenbereich
23.10.2014 10:48:40
Tino
Hallo,
am einfachsten wäre wohl für den Import ein Temp-Tabelle zu verwenden und
die benötigten Daten von dort zu kopieren.
Kannst mal so testen.
Sub CsvMitSemikolonDelimiterInSheetEinfuegen()
Dim wksN As Excel.Worksheet, TmpSheet As Worksheet, aktSheet As Object
Dim qtbN As Excel.QueryTable
Dim vntPathAndFileName As Variant
Dim lngLetzteZeileSpalteA As Long
Const AbZeileImport& = 7
vntPathAndFileName = Application.GetOpenFilename( _
FileFilter:="csv Files (*.csv), *.csv", _
Title:="Meine Dateien ", _
MultiSelect:=False)
If VarType(vntPathAndFileName) = vbBoolean Then
MsgBox "Abgebrochen!"
Exit Sub
End If
On Error GoTo ErrorHandler:
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set wksN = ThisWorkbook.Worksheets("Basisdaten")
lngLetzteZeileSpalteA = wksN.Cells(wksN.Rows.Count, 1).End(xlUp).Row
Set aktSheet = ActiveSheet
Set TmpSheet = Sheets.Add
Set qtbN = TmpSheet.QueryTables.Add("TEXT;" & vntPathAndFileName, TmpSheet.Cells(1, 1))
qtbN.FieldNames = True
qtbN.RowNumbers = False
qtbN.FillAdjacentFormulas = False
qtbN.PreserveFormatting = True
qtbN.RefreshOnFileOpen = False
qtbN.RefreshStyle = xlOverwriteCells
qtbN.SaveData = True
qtbN.AdjustColumnWidth = False
qtbN.RefreshPeriod = 0
qtbN.TextFilePromptOnRefresh = False
qtbN.TextFilePlatform = xlWindows
qtbN.TextFileStartRow = 1
qtbN.TextFileParseType = xlDelimited
qtbN.TextFileTextQualifier = xlTextQualifierNone
qtbN.TextFileTabDelimiter = False
qtbN.TextFileSemicolonDelimiter = True
qtbN.TextFileCommaDelimiter = False
qtbN.TextFileSpaceDelimiter = False
qtbN.TextFileSemicolonDelimiter = True
qtbN.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
qtbN.Refresh BackgroundQuery:=False
qtbN.Delete
TmpSheet.Rows(1).Resize(AbZeileImport - 1).Delete
TmpSheet.UsedRange.Copy wksN.Cells(lngLetzteZeileSpalteA + 1, 1)
ErrorHandler:
If Err.Number  0 Then
MsgBox Err.Description, _
vbCritical + vbMsgBoxSetForeground + vbMsgBoxHelpButton, _
"Error: " & Err.Number, Err.HelpFile, Err.HelpContext
End If
On Error Resume Next
If Not TmpSheet Is Nothing Then TmpSheet.Delete
aktSheet.Select
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Gruß Tino

Anzeige
AW: CSV Import, bestimmter Datenbereich
23.10.2014 11:10:18
andthen
Hallo Tino,
vielen Dank für die schnelle Rückmeldung.
Leider weiß ich nicht was unter einer temporären Tabelle zu verstehen bzw. wie diese zu nutzen ist.
Der Import ohne die Zeilen 1-7 klappt ohne Probleme.
Allerdings werden immer noch die Daten nach der Leerzeile mitkopiert.
Zum besseren Verständnis der Aufbau der Daten:
1 irrlevante Daten (feste Zeilenanzahl)
2 irrlevante Daten
3 irrlevante Daten
4 irrlevante Daten
5 irrlevante Daten
6 irrlevante Daten
7 Daten (beliebige Zeilenanzahl)
8 Daten
9 Daten
10 Daten
11 Daten
12 Daten
13 (LEERZEILE)
14 irrlevante Daten (feste Zeilenanzahl)
15 irrlevante Daten
16 irrlevante Daten
17 irrlevante Daten
18 irrlevante Daten
19 irrlevante Daten
Mit freundlichen Grüßen
andthen

Anzeige
AW: CSV Import, bestimmter Datenbereich
23.10.2014 11:28:04
Tino
Hallo,
als temporären Tabelle meine ich eine Tabelle die für den Import erstellt und
danach wieder gelöscht wird.
In dieser lösche ich die Zeilen 1 bis 6 und kopiere den zusammenhängenden Block.
Teste mal so.
Sub CsvMitSemikolonDelimiterInSheetEinfuegen()
Dim wksN As Excel.Worksheet, TmpSheet As Worksheet, aktSheet As Object
Dim qtbN As Excel.QueryTable
Dim vntPathAndFileName As Variant
Dim lngLetzteZeileSpalteA As Long
Const AbZeileImport& = 7
vntPathAndFileName = Application.GetOpenFilename( _
FileFilter:="csv Files (*.csv), *.csv", _
Title:="Meine Dateien ", _
MultiSelect:=False)
If VarType(vntPathAndFileName) = vbBoolean Then
MsgBox "Abgebrochen!"
Exit Sub
End If
On Error GoTo ErrorHandler:
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set wksN = ThisWorkbook.Worksheets("Basisdaten")
lngLetzteZeileSpalteA = wksN.Cells(wksN.Rows.Count, 1).End(xlUp).Row
Set aktSheet = ActiveSheet
Set TmpSheet = Sheets.Add
Set qtbN = TmpSheet.QueryTables.Add("TEXT;" & vntPathAndFileName, TmpSheet.Cells(1, 1))
qtbN.FieldNames = True
qtbN.RowNumbers = False
qtbN.FillAdjacentFormulas = False
qtbN.PreserveFormatting = True
qtbN.RefreshOnFileOpen = False
qtbN.RefreshStyle = xlOverwriteCells
qtbN.SaveData = True
qtbN.AdjustColumnWidth = False
qtbN.RefreshPeriod = 0
qtbN.TextFilePromptOnRefresh = False
qtbN.TextFilePlatform = xlWindows
qtbN.TextFileStartRow = 1
qtbN.TextFileParseType = xlDelimited
qtbN.TextFileTextQualifier = xlTextQualifierNone
qtbN.TextFileTabDelimiter = False
qtbN.TextFileSemicolonDelimiter = True
qtbN.TextFileCommaDelimiter = False
qtbN.TextFileSpaceDelimiter = False
qtbN.TextFileSemicolonDelimiter = True
qtbN.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
qtbN.Refresh BackgroundQuery:=False
qtbN.Delete
With TmpSheet
.Rows(1).Resize(AbZeileImport - 1).Delete
.Range(TmpSheet.Cells(1, 1), .Cells(1, 1).End(xlDown)).EntireRow.Copy wksN.Cells( _
lngLetzteZeileSpalteA + 1, 1)
End With
ErrorHandler:
If Err.Number  0 Then
MsgBox Err.Description, _
vbCritical + vbMsgBoxSetForeground + vbMsgBoxHelpButton, _
"Error: " & Err.Number, Err.HelpFile, Err.HelpContext
End If
On Error Resume Next
If Not TmpSheet Is Nothing Then TmpSheet.Delete
aktSheet.Select
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Gruß Tino

Anzeige
AW: CSV Import, bestimmter Datenbereich
23.10.2014 11:32:48
andthen
Hallo,
super, dieser Code funktioniert einwandfrei!
Ich danke dir vielmals.
Mit freundlichem Gruß
andthen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige