Textdatei aus einem Klick auswerten

Sub TextDateien_auswaehlen()
Dim Zeile As Long, fd As FileDialog
Dim varFilename
With Tab_Steuern
Zeile = .Cells(.Rows.Count, 1).End(xlUp).Row
If Zeile > 6 Then
.Range(.Rows(7), .Rows(Zeile)).ClearContents
End If
Set fd = Application.FileDialog(msoFileDialogOpen)
With fd
.Title = "Bitte Textdatei(en) mit Daten auswählen - Mehrfachauswahl is möglich"
.AllowMultiSelect = True
.InitialFileName = "*.txt"
End With
If fd.Show = -1 Then
Zeile = 6
For Each varFilename In fd.SelectedItems
Zeile = Zeile + 1
.Cells(Zeile, 1).Value = varFilename
.Cells(Zeile, 2).Value = "noch nicht importiert"
.Cells(Zeile, 3).Value = VBA.FileDateTime(varFilename)
Next
End If
End With
End Sub
Sub Exceltabelle_erstellen()
Dim bolEineTabelle As Boolean
Dim varFile
Dim wkb As Workbook
Dim wks As Worksheet
Dim Zeile As Long, Zeile_T As Long, Zeile_L As Long
Dim FF As Integer
Dim strText As String, strZeile As String, ZeiText As Long, varZeile, i As Integer
Dim strBlatt As String
Dim bolBanane As Boolean, bolBanane2 As Boolean, bolPferd As Boolean
On Error GoTo Fehler
With Tab_Steuern
Zeile_L = .Cells(.Rows.Count, 1).End(xlUp).Row
bolEineTabelle = .Range("B4") = "Ja"
End With
If Zeile_L  0 Then Exit Do
Loop
'Teiltexte ersetzen, damit beim Splitten
'"--" durch "- " ersetzen
strZeile = VBA.Replace(strZeile, "--", "- ")
'"-Pferd" durch "- Pferd" ersetzen
strZeile = VBA.Replace(strZeile, "-Pferd", "- Pferd")
'" - " durch " " ersetzen
strZeile = VBA.Replace(strZeile, " - ", " ")
'Gleichheitszeichen durch " " ersetzen
strZeile = VBA.Replace(strZeile, "=", " ")
'Doppelte Leerzeichen durch ein Leerzeichen ersetzen
strZeile = VBA.Replace(strZeile, "  ", " ")
'Datensatz am Leerzeichen spltten
varZeile = Split(strZeile, " ")
'Zähler für Zeile in Import-Tabelle erhöhen
Zeile_T = Zeile_T + 1
'                    wks.Cells(Zeile_T, 1).Resize(1, UBound(varZeile) + 1) = varZeile
'                    Zeile_T = Zeile_T + 1
'Spalten im Datensatz auswerten
'Merker setzen für Texte, die ggf. mehrfach vorkommen
bolBanane = False
bolBanane2 = False
bolPferd = False
For i = 0 To UBound(varZeile)
If varZeile(i) = "Birne" Then
wks.Cells(Zeile_T, 8) = varZeile(i + 1): i = i + 1
ElseIf varZeile(i) = "Mango" Then
wks.Cells(Zeile_T, 9) = varZeile(i + 1): i = i + 1
ElseIf varZeile(i) = "Kirsche" Then
wks.Cells(Zeile_T, 10) = varZeile(i + 1): i = i + 1
ElseIf varZeile(i) = "Name" Then
wks.Cells(Zeile_T, 1) = varZeile(i + 1): i = i + 1
ElseIf varZeile(i) = "TiereNr" Then
wks.Cells(Zeile_T, 2) = varZeile(i + 1): i = i + 1
ElseIf varZeile(i) = "Wohnung" Then
wks.Cells(Zeile_T, 3) = varZeile(i + 1): i = i + 1
ElseIf Left(varZeile(i), 6) = "Pferd_" And bolPferd = False Then
wks.Cells(Zeile_T, 4) = Mid(varZeile(i), 7)
bolPferd = True
ElseIf varZeile(i) & varZeile(i + 1) & varZeile(i + 2) _
& varZeile(i + 3) = "ZeitfürBananewar" And bolBanane = False  _
Then
wks.Cells(Zeile_T, 5) = Val(varZeile(i + 4)): i = i + 4
bolBanane = True
ElseIf varZeile(i) & varZeile(i + 1) & varZeile(i + 2) _
= "ZeitfürBanane" And varZeile(i + 3)  "war" And bolBanane2 =  _
_
False Then
If IsDate(varZeile(i - 4)) Then
wks.Cells(Zeile_T, 11) = CDate(Right(varZeile(i - 4), 4) & "-" _
& Mid(varZeile(i - 4), 4, 2) & "-" & Left(varZeile(i - 4), 2)) ' _
_
Datum
wks.Cells(Zeile_T, 12) = CDbl(CDate(Split(varZeile(i - 3), ",")(0))) _
_
_
+ (Val(Split(varZeile(i - 3), ",")(1)) / 1000 / 86400) 'Zeit
wks.Cells(Zeile_T, 13) = Val(Split(varZeile(i - 3), ",")(1))  '1/ _
1000 s
bolBanane2 = True
Else
wks.Cells(Zeile_T, 11) = "Einleseproblem"
End If
ElseIf varZeile(i) & varZeile(i + 1) & varZeile(i + 2) = "MengeproLeute" _
_
Then
wks.Cells(Zeile_T, 6) = Val(varZeile(i + 3)): i = i + 3
ElseIf varZeile(i) & varZeile(i + 1) = "mitWarteTiere" Then
wks.Cells(Zeile_T, 7) = Val(varZeile(i + 2)): i = i + 2
End If
Next
If bolEineTabelle = True Then wks.Cells(Zeile_T, 14) = strBlatt
NextLoop:
Loop
Close #FF
End With
Tab_Steuern.Cells(Zeile, 2).Value = "einglesen - " & Format(Now, "YYYY-MM-DD hh:mm:  _
_
ss")
Next_TextFile:
Next
End If
Fehler:
With Err
Select Case .Number
Case 0
Case 53 'Dateiname nicht gefunden
Tab_Steuern.Cells(Zeile, 2).Value = "Fehler - " & Format(Now, "YYYY-MM-DD hh:mm: _
_
ss")
If bolEineTabelle = False Then wks.Cells(Zeile_T + 2, 1) = _
"Fehler beim Einlesen der Daten aus der Text-Datei"
Resume Next_TextFile
Case Else
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description
Close
End Select
End With
End Sub