AW: Kontoumsätze einlesen
18.10.2008 12:01:00
Tino
Hallo,
habe mal ein Beispiel aufgebaut und an meinen Bankdaten getestet.
Deine Bankdaten bzw. den Aufbau kenne ich nicht, daher kann es sein, dass Du einige Anpassungen vornehmen musst.
Kommentare stehen im Code.
Modul Modul1
Option Explicit
Dim TempTabelle As Worksheet
Sub BankDatenLesen()
Dim strFile As String
Const strPfad As String = "C:\Kontoumsätze\" 'Pfad
With Application
.ScreenUpdating = False
.DisplayAlerts = False
'Erstelle TempTabelle
Set TempTabelle = Sheets.Add
'kopiere vorhandene Daten in Temptabelle
'damit bleibt auch die Überschrift erhalten
Sheets("BankDaten").UsedRange.Copy TempTabelle.Range("A1")
strFile = Dir$(strPfad & "*.csv")
Do Until strFile = "" 'Schleife bis keine Datei mehr vorhanden
txt_ReadLine (strPfad & strFile) 'Pfad und Dateiname
strFile = Dir$ 'nächste Datei suchen
Loop
Call Aufräumen
'Lösche Temptabelle
TempTabelle.Delete
.DisplayAlerts = True
.ScreenUpdating = True
End With
Set TempTabelle = Nothing
End Sub
'Sub zum lesen der Bankdaten ohne die Überschrift.
Public Sub txt_ReadLine(ByVal sFilename As String)
Dim F As Integer
Dim sLine As String
Dim sTemp As Variant
Dim lRow As Long
lRow = 0
' Existiert die Datei ?
If Dir$(sFilename) <> "" Then
' Datei zum Lesen öffnen
F = FreeFile
Open sFilename For Input As #F
While Not EOF(F)
lRow = lRow + 1
Line Input #F, sLine
If lRow > 1 Then
sLine = Replace(sLine, """", "")
sTemp = Split(sLine, ";")
With TempTabelle
.Range(.Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0), .Cells(.Rows.Count, "A").End(xlUp).Offset(1, Ubound(sTemp))) _
= Split(sLine, ";")
End With
End If
Wend
Close #F
End If
End Sub
Sub Aufräumen()
Dim Zellen As Range
Sheets("Bankdaten").Cells.Clear
With TempTabelle
'mit Spezialfilter doppelte ausfiltern
.Range("A1", .Cells.SpecialCells(xlCellTypeLastCell)).AdvancedFilter Action:=xlFilterInPlace, Unique:=True
'Sichtbare Zellen bestimmen
Set Zellen = .UsedRange.SpecialCells(xlCellTypeVisible)
End With
'Sichtbare Zellen in Tabelle Bankdaten kopieren
Zellen.Copy
Sheets("Bankdaten").Range("A1").PasteSpecial
Set Zellen = Nothing
End Sub
Gruß Tino
www.VBA-Excel.de