Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1728to1732
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

Daten aus TXT-Datei auslesen und in Zellen eintragen?

Daten aus TXT-Datei auslesen und in Zellen eintragen?
28.12.2019 22:33:35
Sergej
Hallo Leute,
ich habe in der Datei S:\Daten\Prj\Service\data.txt zeilenweise verschiedene Einträge stehen:
Projektnummer: 002390099-TS
Projektname: Hochschule Herder
Zimmer:
Beleg:
Mitarbeiter:[name]
Datum: [date]
Firma:
Strasse:
Stadt:

Wie kann ich bitte per VBA folgendes erledigen:
1. nach Projektnummer: in der Textdatei suchen, dann den Text der danach kommt in die Zelle PNR eintragen
2. nach Projektname: in der Textdatei suchen, dann den Text der danach kommt in die Zelle PNAME eintragen
3. nach Mitarbeiter: in der Textdatei suchen, dann den Text der danach kommt in die Zelle B5 eintragen
usw.
Anmerkungen:
  • Wenn in der Textdatei in eckigen Klammern [name] steht, dann soll der Windows Benutzername ausgegeben werden.

  • Wenn in der Textdatei in eckigen Klammern [date] steht, dann soll das Datum im Form TT.MM.JJJJ ausgegeben werden.

  • Wenn in der Textdatei nach dem ersten Doppelpunkt kein Inhalt steht (siehe beispielsweise Zimmer:), dann für Zimmer nicht berücksichtigt werden

  • Herzlichen Dank im Voraus!
    Beste Grüße,
    Sergej

    11
    Beiträge zum Forumthread
    Beiträge zu diesem Forumthread

    Betreff
    Datum
    Anwender
    Anzeige
    AW: Daten aus TXT-Datei auslesen und in Zellen eintragen?
    28.12.2019 23:05:30
    onur
    Hier kannst du Hilfe für kleinere Probleme bekommen, aber keine Komplettlösung. Dafür gibt es Auftragsprogrammierer.
    AW: Daten aus TXT-Datei auslesen und in Zellen eintragen?
    29.12.2019 00:12:01
    volti
    Hallo Sergej,
    deine Beschreibung ist nicht ganz eindeutig.
    Stehen in der Textdatei nur einmalig diese Eintragungen?
    Sind die Zielfelder benamt?
    Möchtest Du die Einträge einzeln per Aufruf extrahieren oder alle in einem Rutsch übernehmen?
    Hier mal eine mögliche Vorgehensweise:
    Sub DatenUebernehmen()
     Dim Data As String, sPfad As String, sDatei As String
     sPfad = "S:\Daten\Prj\Service"
     sDatei = "Data.txt"
     Close #1: Open sPfad & "\" & sDatei For Binary As #1
     Data = Space(LOF(1)): Get #1, , Data
     Close #1
     On Error Resume Next
     Range("PNR").Value = SucheInDaten(Data, "Projektnummer")
     Range("PName").Value = SucheInDaten(Data, "Projektname")
     Range("$B$5").Value = SucheInDaten(Data, "Mitarbeiter")
     Range("PDatum").Value = SucheInDaten(Data, "Datum")
     '....
    End Sub
    Function SucheInDaten(Data As String, ByVal sSuch As String) As String
    'Funktion ermittelt einen Eintrag aus Textdaten
     Dim P1 As Long, P2 As Long
     sSuch = Replace(sSuch, ":", "") & ":"
     P1 = InStr(Data, sSuch) + Len(sSuch)
     If P1 > Len(sSuch) Then
      P2 = InStr(P1, Data & vbCrLf, vbCrLf)
      SucheInDaten = Trim$(Mid$(Data, P1, P2 - P1))
      Select Case SucheInDaten
      Case "[name]": SucheInDaten = Environ$("Username")
      Case "[date]": SucheInDaten = Format$(Date, "dd.MM.yyyy")
      End Select
     End If
    End Function

    viele Grüße
    Karl-Heinz


    Anzeige
    AW: Daten aus TXT-Datei auslesen und in Zellen eintragen?
    29.12.2019 08:52:17
    volti
    Hier noch für Gesamtbearbeitung etwas optimiert:
    Sub Datenübernehmen()
     Dim sZeile As String, sArr() As String
     Close #1: Open "S:\Daten\Prj\Service\data.txt" For Input As #1
     While Not EOF(1)
      Line Input #1, sZeile
      sArr = Split(sZeile, ":")
      If UBound(sArr) > 0 Then
        Select Case Trim$(sArr(1))
        Case "[name]": sArr(1) = Environ$("Username")
        Case "[date]": sArr(1) = Format$(Date, "dd.MM.yyyy")
        End Select
        On Error Resume Next
        Select Case sArr(0)
        Case "Projektnummer": Range("PNR").Value = sArr(1)
        Case "Projektname":   Range("PName").Value = sArr(1)
        Case "Mitarbeiter":   Range("$B$5").Value = sArr(1)
        Case "Datum":         Range("PDatum").Value = sArr(1)
        '... usw.
        Case Else
        End Select
        On Error GoTo 0
      End If
     Wend
     Close #1
    End Sub

    viele Grüße
    Karl-Heinz

    Anzeige
    AW: Daten aus TXT-Datei auslesen und in Zellen eintragen?
    29.12.2019 10:41:18
    Sergej
    Einen wunderschönen guten Morgen Karl-Heinz,
    ich habe es getestet. Es funktioniert hervorragend! Herzlichen Dank!
    Lässt sich bitte nur das Leerzeichen direkt nach dem ersten Doppelpunkt des Suchbegriffs ignorieren, damit nachher der Zellinhalt keine Leerzeichen am Anfang hat?
    Bsp. Eintragungen vom Anwender:
    Projektnummer: 2019 2500880
    Projektnummer:2019 2500880

    Beste Grüße,
    Sergej
    AW: Daten aus TXT-Datei auslesen und in Zellen eintragen?
    29.12.2019 11:54:29
    volti
    Hallo Sergej,
    ja natürlich lässt sich das eliminieren. Hatte ich vergessen.
    If UBound(sArr) > 0 Then
    sArr(1)=Trim$(sArr(1))
    Select Case sArr(1)
    viele Grüße
    Karl-Heinz
    Anzeige
    AW: Daten aus TXT-Datei auslesen und in Zellen eintragen?
    29.12.2019 12:47:46
    Sergej
    Hallo Karl-Heinz,
    das funktioniert ebenfalls perfekt!
    Aller letzte Frage :-)
    Wenn die Zellen die Inhalte haben, dann sollen diese nicht aus den Einträgen der TXT-Datei überschrieben werden. Lässt sich dies bitte noch berücksichtigen?
    Beste Grüße,
    Sergej
    AW: Daten aus TXT-Datei auslesen und in Zellen eintragen?
    29.12.2019 13:03:30
    volti
    Hallo Sergej,
    probiere mal dieses hier:
    Sub Datenübernehmen()
     Dim sZeile As String, sArr() As String, sZiel As String
     Close #1: Open "S:\Daten\Prj\Service\data.txt" For Input As #1
     While Not EOF(1)
      Line Input #1, sZeile
      sArr = Split(sZeile, ":")
      If UBound(sArr) > 0 Then
        Select Case Trim$(sArr(1))
        Case "[name]": sArr(1) = Environ$("Username")
        Case "[date]": sArr(1) = Format$(Date, "dd.MM.yyyy")
        End Select
        Select Case sArr(0)
        Case "Projektnummer": sZiel = "PNR"
        Case "Projektname":   sZiel = "PName"
        Case "Mitarbeiter":   sZiel = "$B$5"
        Case "Datum":         sZiel = "PDatum"
        '... usw.
        Case Else:            sZiel = ""
        End Select
        On Error Resume Next
        If sZiel <> "" Then
           If IsEmpty(Range(sZiel)) Then Range(sZiel) = Trim$(sArr(1))
        End If
        On Error GoTo 0
      End If
     Wend
     Close #1
    End Sub

    viele Grüße
    Karl-Heinz

    Anzeige
    AW: Daten aus TXT-Datei auslesen und in Zellen eintragen?
    29.12.2019 13:17:29
    Sergej
    Hallo Karl-Heinz,
    funktioniert auch perfekt. Vielen herzlichen Dank!
    Beste Grüße,
    Sergej
    AW: Daten aus TXT-Datei auslesen und in Zellen eintragen?
    29.12.2019 14:15:33
    Sergej
    Hallo Karl-Heinz,
    was muss ich bitte noch einstellen, damit das Makro an alle Arbeitsblätter der Datei angewendet wird?
    Beste Grüße,
    Sergej
    AW: Daten aus TXT-Datei auslesen und in Zellen eintragen?
    29.12.2019 17:30:12
    volti
    Hallo Sergej,
    hiermit werden alle Blätter der Datei gleichermaßen gefüllt. Aber war das so gemeint?
    Sub Datenübernehmen()
     Dim sZeile As String, sArr() As String, sZiel As String, oBlatt As Worksheet
     Close #1: Open "S:\Daten\Prj\Service\data.txt" For Input As #1
     While Not EOF(1)
      Line Input #1, sZeile
      sArr = Split(sZeile, ":")
      If UBound(sArr) > 0 Then
        Select Case Trim$(sArr(1))
        Case "[name]": sArr(1) = Environ$("Username")
        Case "[date]": sArr(1) = Format$(Date, "dd.mm.yyyy")
        End Select
        Select Case sArr(0)
        Case "Projektnummer": sZiel = "PNR"
        Case "Projektname":   sZiel = "PName"
        Case "Mitarbeiter":   sZiel = "$B$5"
        Case "Datum":         sZiel = "PDatum"
        '... usw.
        Case Else:            sZiel = ""
        End Select
        On Error Resume Next
        If sZiel <> "" Then
           For Each oBlatt In ThisWorkbook.Worksheets
             If IsEmpty(oBlatt.Range(sZiel)) Then
                oBlatt.Range(sZiel).Value = Trim$(sArr(1))
             End If
           Next oBlatt
        End If
        On Error GoTo 0
      End If
     Wend
     Close #1
    End Sub

    viele Grüße
    Karl-Heinz

    Anzeige
    AW: Daten aus TXT-Datei auslesen und in Zellen eintragen?
    29.12.2019 18:39:45
    Sergej
    Hallo Karl-Heinz,
    vielen herzlichen Dank.
    Ich habe nachhinein gesehen, dass ich auch Excel-Dateien habe, die auch mehreren Arbeitsblättern haben. ;-)
    Beste Grüße,
    Sergej

    328 Forumthreads zu ähnlichen Themen

    Anzeige
    Anzeige
    Anzeige

    Beliebteste Forumthreads (12 Monate)

    Anzeige

    Beliebteste Forumthreads (12 Monate)

    Anzeige
    Anzeige
    Anzeige