Thema Datum  Von Nutzer Rating
Antwort
07.08.2017 17:04:17 Sarah
NotSolved
07.08.2017 18:14:07 Gast87494
*****
NotSolved
Rot Mehrere Textdateien in eine Exceltabelle-Trennteichen Tab
07.08.2017 19:02:45 Gast44009
*****
NotSolved
08.08.2017 08:39:43 Gast35139
NotSolved
08.08.2017 15:34:45 Gast44009
NotSolved

Ansicht des Beitrags:
Von:
Gast44009
Datum:
07.08.2017 19:02:45
Views:
632
Rating: Antwort:
  Ja
Thema:
Mehrere Textdateien in eine Exceltabelle-Trennteichen Tab

Für Anfänger (Zeit spielt keine Rolle - Forum läuft erst zum 31.08.17 aus!)

Option Explicit
Sub einlesen() 'auf aktives Tabellenblatt !!!!
Dim strExt, ZuÖffnendeDatei, strPath, strFile
Dim Arr1() As String, Arr2() As String, i As Integer, x As Integer

    strExt = "*.txt"
    ZuÖffnendeDatei = Application.GetOpenFilename("Textdateien (" & strExt & "), " & strExt, _
    Title:="Verzeichnisauswahl, erste Datei auswählen")
    If ZuÖffnendeDatei = False Then Exit Sub
     
    strPath = CurDir & "\"
    If strPath = "" Then
        Exit Sub
    Else
        Application.ScreenUpdating = False
        ChDir strPath
        'auf aktives Tabellenblatt !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
        Cells.Clear
        
        strFile = Dir(strPath & strExt)
        Do While Len(strFile) > 0
         Arr1 = TextFileToArray(strFile)
         '-23 Zeilen
         For i = 23 To UBound(Arr1)
            Arr2 = Split(Arr1(i), Chr(9))
            x = Cells(Rows.Count, 1).End(xlUp)(2).Row
            On Error Resume Next
            Cells(x, 1).Resize(1, UBound(Arr2) + 1).Value = Arr2
            On Error GoTo 0
         Next i
            'Workbooks.OpenText Filename:=strPath & strFile, DataType:=xlDelimited, _
                TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, _
                Tab:=True, Semicolon:=False, Comma:=False, _
                Space:=True, Other:=False, trailingMinusNumbers:=True
            'Sheets(1).Move After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
           strFile = Dir()
        Loop
        Application.ScreenUpdating = True
    End If
End Sub

Private Function TextFileToArray(ByVal strFileName As String) As Variant
''Zweck Textdatei - alle Zeilen als Array zurück
''
Dim sWhole As String

   Open strFileName For Input As #1
   sWhole = Input$(LOF(1), 1)
   Close #1
   TextFileToArray = Split(sWhole, vbNewLine)

End Function

 


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
07.08.2017 17:04:17 Sarah
NotSolved
07.08.2017 18:14:07 Gast87494
*****
NotSolved
Rot Mehrere Textdateien in eine Exceltabelle-Trennteichen Tab
07.08.2017 19:02:45 Gast44009
*****
NotSolved
08.08.2017 08:39:43 Gast35139
NotSolved
08.08.2017 15:34:45 Gast44009
NotSolved