Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

CSV Import, bestimmter Datenbereich

Betrifft: CSV Import, bestimmter Datenbereich von: andthen
Geschrieben am: 23.10.2014 10:11:01

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

  

Betrifft: AW: CSV Import, bestimmter Datenbereich von: Tino
Geschrieben am: 23.10.2014 10:48:40

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


  

Betrifft: AW: CSV Import, bestimmter Datenbereich von: andthen
Geschrieben am: 23.10.2014 11:10:18

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


  

Betrifft: AW: CSV Import, bestimmter Datenbereich von: Tino
Geschrieben am: 23.10.2014 11:28:04

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


  

Betrifft: AW: CSV Import, bestimmter Datenbereich von: andthen
Geschrieben am: 23.10.2014 11:32:48

Hallo,

super, dieser Code funktioniert einwandfrei!
Ich danke dir vielmals.

Mit freundlichem Gruß
andthen


 

Beiträge aus den Excel-Beispielen zum Thema "CSV Import, bestimmter Datenbereich"