Datum

Titel

18.04.2024 21:09:11

4 Spalten aus smarter Tabelle in andere smarte Tab. kopieren

18.04.2024 20:45:35

Worksheet_Activate für alle Sheets

18.04.2024 19:30:20

VBA - Tabelle mit Mannschaftsergebnissen sortieren

18.04.2024 18:04:29

Formel fehler Wert#

Du findest keine passende Antwort auf Deine Frage?

Stelle Deine Frage in unserem Live-Forum

Archiv - Navigation

1668to1672

Aktuelles Verzeichnis

Verzeichnis Index

Übersicht Verzeichnisse

Vorheriger Thread

Rückwärts Blättern

Nächster Thread

Vorwärts blättern

HERBERS

Excel-Forum (Archiv)

20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender

Rückwärts Blättern

Aktuelles Verzeichnis

Übersicht Verzeichnisse

Vorwärts blättern

Inhaltsverzeichnis

4 Werte in Zeile in Textfile finden

Forumthread: 4 Werte in Zeile in Textfile finden
20 Beiträge zu diesem Forumthread
Anzeige
306 Threads zu ähnlichen Themen
VBA Beispiele zu verwandten Themen

Top 100 Forumthreads

23.01.2019 15:06:46

MarC

Hallo alle miteinand,
ich habe einen Code geschrieben der Textfiles in meinem Ordner nach einem bestimmten Begriff durchsucht und mir dann 4 Werte ausgeben soll. Wert 1 ist der Name des Files (muss in Spalte 1) das klappt. Wert 2 ist das Datum + Uhrzeit (muss in Spalte 2)welches ganz vorne in der gefunden Zeile steht. Wert 3 und 4 stehen irgendwo in der Mitte der gefunden Zeile (müssen in Spalte 3 und 4) und sehen ungefähr so aus ##G2U3898040001118112 (hier ändern sich immer nur die Zahlen)
So sieht die komplette Zeile aus die gefunden wurde:
2019-01-06 09:48:44.433:S->C :#01##P*******P*******##Ready to start****************Ready to start****************##TZUER**##W10117##G2U38980400011556******##******************************##D34598029********************##G2U3898040001118112******##*********
So sieht mein aktueller Code aus:

Sub findWordinTXT()
Dim sWord1 As String, sPath As String, sSearchPath As String, FileName As String, InputData,  _
sword2 As String
Dim AnzFound As Integer
AnzFound = 0
'Wort nach dem gesucht werden soll
sWord1 = "Ready"
'Suche nach allen Textdateien im Verzeichnis c:\temp\xl
sSearchPath = "C:\Users\*.txt"
sPath = "C:\Users\"
FileName = Dir(sSearchPath)
If FileName  "" Then
Do While FileName  ""
Open sPath & FileName For Input As #1
Do While Not EOF(1)
Line Input #1, InputData
If InStr(1, InputData, sWord1) > 0 Then
'Zeile mit Suchwort gefunden
AnzFound = AnzFound + 1
Sheets("Cache").Cells(AnzFound, 1) = FileName
Sheets("Cache").Cells(AnzFound, 2) = InputData          'Datum
Sheets("Cache").Cells(AnzFound, 3) = InputData
Sheets("Cache").Cells(AnzFound, 4) = InputData
End If
Loop
Close #1
'nächste Datei
FileName = Dir
Loop
End If
End Sub

Würde mir bitte jemand helfen damit ich das Datum in die Spalte 2 und die beiden Werte in Spalte 3 und 4 bringe?

20
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: 4 Werte in Zeile in Textfile finden

23.01.2019 15:26:48

Sepp
AW: 4 Werte in Zeile in Textfile finden

23.01.2019 19:06:39

MaRc
AW: 4 Werte in Zeile in Textfile finden

23.01.2019 19:20:22

Sepp
Danke Sepp. Um eine Abfrage erweitern?

23.01.2019 22:42:13

MarC
AW: Danke Sepp. Um eine Abfrage erweitern?

23.01.2019 23:03:04

Sepp
AW: Danke Sepp. Um eine Abfrage erweitern?

23.01.2019 23:31:07

MarC
AW: Danke Sepp. Um eine Abfrage erweitern?

24.01.2019 07:50:43

Sepp
AW: Danke Sepp. Um eine Abfrage erweitern?

24.01.2019 08:38:00

MarC
AW: Danke Sepp. Um eine Abfrage erweitern?

24.01.2019 08:50:58

Sepp
AW: Danke Sepp. Um eine Abfrage erweitern?

24.01.2019 08:58:56

MarC
AW: Danke Sepp. Um eine Abfrage erweitern?

24.01.2019 11:06:26

Sepp
AW: Danke Sepp. Um eine Abfrage erweitern?

24.01.2019 12:05:27

MarC
AW: Danke Sepp. Um eine Abfrage erweitern?

24.01.2019 13:08:32

Sepp
AW: Danke Sepp. Um eine Abfrage erweitern?

24.01.2019 14:22:48

MarC
AW: Danke Sepp. Um eine Abfrage erweitern?

24.01.2019 14:51:07

Sepp
AW: Danke Sepp. Um eine Abfrage erweitern?

25.01.2019 10:22:21

MarC
AW: Danke Sepp. Um eine Abfrage erweitern?

25.01.2019 16:51:26

Sepp
AW: Danke Sepp. Um eine Abfrage erweitern?

25.01.2019 20:59:33

MarC
AW: Danke Sepp. Um eine Abfrage erweitern?

25.01.2019 21:13:25

Sepp
AW: Danke Sepp. Um eine Abfrage erweitern?

25.01.2019 21:34:24

MarC

AW: 4 Werte in Zeile in Textfile finden

23.01.2019 15:26:48

Sepp

Hallo Marc,
probier mal (anhand deiner Vorgaben!).

Sub findWordinTXT()
  Dim sWord1 As String, sPath As String, sSearchPath As String, FileName As String, InputData, sword2 As String
  Dim AnzFound As Integer
  Dim InputData As String, varInput As Variant, lngI As Long
  Dim dateInput As Date, FirstNumber As String, SecondNumber As String
  AnzFound = 0
  'Wort nach dem gesucht werden soll 
  sWord1 = "Ready"
  'Suche nach allen Textdateien im Verzeichnis c:\temp\xl 
  sSearchPath = "C:\Users\*.txt"
  sPath = "C:\Users\"
  FileName = Dir(sSearchPath)
  If FileName <> "" Then
    Do While FileName <> ""
      Open sPath & FileName For Input As #1
      Do While Not EOF(1)
        Line Input #1, InputData
        If InStr(1, InputData, sWord1) > 0 Then
          'Zeile mit Suchwort gefunden 
          AnzFound = AnzFound + 1
          Sheets("Cache").Cells(AnzFound, 1) = FileName
          FirstNumber = ""
          SecondNumber = ""
          InputData = Replace(InputData, "*", "")
          varInput = Split(InputData, "##")
          dateInput = CDate(Left(varInput(0), 19))
          For lngI = 1 To Ubound(varInput)
            If varInput(lngI) Like "?#?##########*" Then
              If Len(FirstNumber) = 0 Then
                FirstNumber = varInput(lngI)
              ElseIf Len(SecondNumber) = 0 Then
                SecondNumber = varInput(lngI)
                Exit For
              End If
            End If
          Next
          Sheets("Cache").Cells(AnzFound, 2) = dateInput          'Datum 
          Sheets("Cache").Cells(AnzFound, 3) = FirstNumber
          Sheets("Cache").Cells(AnzFound, 4) = SecondNumber
        End If
      Loop
      Close #1
      'nächste Datei 
      FileName = Dir
    Loop
  End If
End Sub

VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media
Code erstellt und getestet in Office 16 - mit VBAHTML 12.6.0

	A	B	C	D	E	F
1	Gruß Sepp
2
3

AW: 4 Werte in Zeile in Textfile finden

23.01.2019 19:06:39

MaRc

Danke Sepp,
der Code läuft. Jetzt habe ich aber noch zwei Fragen oder Anliegen. Nach dem der Code fertig war hat sich rausgestellt das nicht jede Zeile eine SecondNumber besitzt. Stattdessen wurde eine andere Nummer als SecondNumber gespeichert. Kann die SecondNumber nicht weggelassen werden wenn keine gefunden wird oder die gefundene Nummer nicht mit G2U beginnt? G2U ist ein fester Wert am Anfang.
Zweite Frage was bedeutet der Code bzw für was stehen die einzelnen Werte? If varInput(lngI) Like "?#?##########*" Then

AW: 4 Werte in Zeile in Textfile finden

23.01.2019 19:20:22

Sepp

Hallo Marc,

Sub findWordinTXT()
  Dim sWord1 As String, sPath As String, sSearchPath As String, FileName As String, InputData, sword2 As String
  Dim AnzFound As Integer
  Dim InputData As String, varInput As Variant, lngI As Long
  Dim dateInput As Date, FirstNumber As String, SecondNumber As String
  AnzFound = 0
  'Wort nach dem gesucht werden soll 
  sWord1 = "Ready"
  'Suche nach allen Textdateien im Verzeichnis c:\temp\xl 
  sSearchPath = "C:\Users\*.txt"
  sPath = "C:\Users\"
  FileName = Dir(sSearchPath)
  If FileName <> "" Then
    Do While FileName <> ""
      Open sPath & FileName For Input As #1
      Do While Not EOF(1)
        Line Input #1, InputData
        If InStr(1, InputData, sWord1) > 0 Then
          'Zeile mit Suchwort gefunden 
          AnzFound = AnzFound + 1
          Sheets("Cache").Cells(AnzFound, 1) = FileName
          FirstNumber = ""
          SecondNumber = ""
          InputData = Replace(InputData, "*", "")
          varInput = Split(InputData, "##")
          dateInput = CDate(Left(varInput(0), 19))
          For lngI = 1 To Ubound(varInput)
            If varInput(lngI) Like "G2U##########*" Then
              If Len(FirstNumber) = 0 Then
                FirstNumber = varInput(lngI)
              ElseIf Len(SecondNumber) = 0 Then
                SecondNumber = varInput(lngI)
                Exit For
              End If
            End If
          Next
          Sheets("Cache").Cells(AnzFound, 2) = dateInput          'Datum 
          Sheets("Cache").Cells(AnzFound, 3) = FirstNumber
          Sheets("Cache").Cells(AnzFound, 4) = SecondNumber
        End If
      Loop
      Close #1
      'nächste Datei 
      FileName = Dir
    Loop
  End If
End Sub

VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media
Code erstellt und getestet in Office 16 - mit VBAHTML 12.6.0

Die # stehen im Like-Operator für eine Zahl, der * steht für ein oder mehrere beliebige Zeichen

	A	B	C	D	E	F
1	Gruß Sepp
2
3

Danke Sepp. Um eine Abfrage erweitern?

23.01.2019 22:42:13

MarC

Danke Sepp für deine Hilfe. Meine Ursprungsfrage bzw Problem ist erledigt dennoch muss ich dich fragen wie ich den code erweitern kann. Wenn eine Zeile mit Numbers gefunden wurde kommt in der nächsten oder übernächsten (vll aber auch erst 10 Zeilen später) Zeilen eine lange Zeichenfolge in denen 1 oder 2 Messwerte stehen. Nach diesen Messwerten kommen dann die nächsten Numbers und dann wieder anschließend Messwerte und immer so weiter.
Die Messwerte möchte ich gerne in Spalte 5 und 6 schreiben so das ich diese den Numbers zuordnen kann. Die Messwerte sind im Textfile immer so hinterlegt z.B. 0.619 oder 0.614
Die komplette Zeile in der die Messwerte stehen sieht wie folgt aus.


2017-02-26 07:43:12.325:S->C :#03##P*******P*******##Sst passed********************Sst passed********************##P*******P*******##003330010001********00******************003330010001********00******************##   0.619##00000.03##000044.0##00000000##00000.00##00000.00##********##********##********##********##********##********##********##********##********##   0.614##00000.03##000044.0##00000000##00000.00##00000.00##********##********##********##********##********##********##********##********##********##****************************************************************************************************************#

AW: Danke Sepp. Um eine Abfrage erweitern?

23.01.2019 23:03:04

Sepp

Hallo Marc,
es wäre besser wenn du ein Beispiel-Textfile hochlädst und beschreibst, welche Daten du auslesen willst.

	A	B	C	D	E	F
1	Gruß Sepp
2
3

AW: Danke Sepp. Um eine Abfrage erweitern?

23.01.2019 23:31:07

MarC

Hi Sepp,
ich habe schnell ein Beispiel File erstellt welche aber nur zwei Datensätze enthält. Die Daten sollen aus dem txt File kopiert werden. Die Werte die ich benötige habe ich in Word gelb markiert was ja leider im txt File nicht geht.
https://www.herber.de/bbs/user/127050.txt
https://www.herber.de/bbs/user/127049.doc

AW: Danke Sepp. Um eine Abfrage erweitern?

24.01.2019 07:50:43

Sepp

Hallo Marc,
teste mal.

Sub findWordinTXT()
  Dim sWord1 As String, sSearchPath As String, sPath As String, FileName As String, sword2 As String
  Dim AnzFound As Integer, FF As Integer
  Dim InputData As String, varInput As Variant, lngI As Long, lngJ As Long, strLine() As String
  Dim dateInput As Date, FirstNumber As String, SecondNumber As String, FirstValue As Double, SecondValue As Double
  Dim bolMatch As Boolean, bolComplete As Boolean
  'Wort nach dem gesucht werden soll 
  sWord1 = "Ready to start"
  sword2 = "Ddt passed"
  'Suche nach allen Textdateien im Verzeichnis c:\temp\xl 
  sSearchPath = "C:\Users\*.txt"
  sPath = "C:\Users\"
  FileName = Dir(sSearchPath)
  If FileName <> "" Then
    FF = FreeFile
    Do While FileName <> ""
      Open sPath & FileName For Input As #FF
      Do While Not EOF(FF)
        Line Input #FF, InputData
        Redim Preserve strLine(lngI)
        strLine(lngI) = Replace(InputData, "*", "")
        lngI = lngI + 1
      Loop
      Close #FF
      For lngI = 0 To Ubound(strLine)
        If Not bolMatch Then
          If InStr(1, strLine(lngI), sWord1) > 0 Then
            bolMatch = True
            varInput = Split(strLine(lngI), "##")
            dateInput = CDate(Left(varInput(0), 19))
            For lngJ = 1 To Ubound(varInput)
              If varInput(lngJ) Like "G2U##########*" Then
                If Len(FirstNumber) = 0 Then
                  FirstNumber = varInput(lngJ)
                ElseIf Len(SecondNumber) = 0 Then
                  SecondNumber = varInput(lngJ)
                  Exit For
                End If
              End If
            Next
          End If
        ElseIf bolMatch Then
          If InStr(1, strLine(lngI), sword2) > 0 Then
            varInput = Split(strLine(lngI), "##")
            FirstValue = CDbl(Trim(Replace(varInput(5), ".", ",")))
            SecondValue = CDbl(Trim(Replace(varInput(20), ".", ",")))
            bolComplete = True
          End If
          If bolComplete Then
            AnzFound = AnzFound + 1
            With Sheets("Cache")
              .Cells(AnzFound, 1) = FileName
              .Cells(AnzFound, 2) = dateInput
              .Cells(AnzFound, 3) = FirstNumber
              .Cells(AnzFound, 4) = SecondNumber
              .Cells(AnzFound, 5) = FirstValue
              .Cells(AnzFound, 6) = SecondValue
            End With
            dateInput = 0: FirstNumber = "": SecondNumber = "": FirstValue = 0: SecondValue = 0
            bolComplete = False
            bolMatch = False
          End If
        End If
      Next
      FileName = Dir
    Loop
  End If
End Sub

VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media
Code erstellt und getestet in Office 16 - mit VBAHTML 12.6.0

	A	B	C	D	E	F
1	Gruß Sepp
2
3

AW: Danke Sepp. Um eine Abfrage erweitern?

24.01.2019 08:38:00

MarC

Morgen Sepp,
also der Code funktioniert bei den Beispieldaten die ich dir hochgeladen habe. Aber er funktioniert nicht bei den Original Daten. Anscheinend habe ich zu viel verändert. Jetzt muss ich wohl einen Teil der Original Daten hochladen =/
Bei den original Daten muss nach Uut passed gesucht werden und die Nummern beginnen mit A2C und nicht mit G2U. Sorry wegen dem hin und her aber ich wollte vermeiden die richtigen Daten hochladen zu müssen.
Datensatz:
https://www.herber.de/bbs/user/127054.txt

AW: Danke Sepp. Um eine Abfrage erweitern?

24.01.2019 08:50:58

Sepp

Hallo Marc,
das hättest du selber auch hinbekommen.

Sub findWordinTXT()
  Dim sWord1 As String, sSearchPath As String, sPath As String, FileName As String, sword2 As String
  Dim AnzFound As Integer, FF As Integer
  Dim InputData As String, varInput As Variant, lngI As Long, lngJ As Long, strLine() As String
  Dim dateInput As Date, FirstNumber As String, SecondNumber As String, FirstValue As Double, SecondValue As Double
  Dim bolMatch As Boolean, bolComplete As Boolean
  'Wort nach dem gesucht werden soll 
  sWord1 = "Ready to start"
  sword2 = "Uut passed"
  'Suche nach allen Textdateien im Verzeichnis c:\temp\xl 
  sSearchPath = "C:\Users\*.txt"
  sPath = "C:\Users\"
  FileName = Dir(sSearchPath)
  If FileName <> "" Then
    FF = FreeFile
    Do While FileName <> ""
      Open sPath & FileName For Input As #FF
      Do While Not EOF(FF)
        Line Input #FF, InputData
        Redim Preserve strLine(lngI)
        strLine(lngI) = Replace(InputData, "*", "")
        lngI = lngI + 1
      Loop
      Close #FF
      For lngI = 0 To Ubound(strLine)
        If Not bolMatch Then
          If InStr(1, strLine(lngI), sWord1) > 0 Then
            bolMatch = True
            varInput = Split(strLine(lngI), "##")
            dateInput = CDate(Left(varInput(0), 19))
            For lngJ = 1 To Ubound(varInput)
              If varInput(lngJ) Like "A2C##########*" Then
                If Len(FirstNumber) = 0 Then
                  FirstNumber = varInput(lngJ)
                ElseIf Len(SecondNumber) = 0 Then
                  SecondNumber = varInput(lngJ)
                  Exit For
                End If
              End If
            Next
          End If
        ElseIf bolMatch Then
          If InStr(1, strLine(lngI), sword2) > 0 Then
            varInput = Split(strLine(lngI), "##")
            FirstValue = CDbl(Trim(Replace(varInput(5), ".", ",")))
            SecondValue = CDbl(Trim(Replace(varInput(20), ".", ",")))
            bolComplete = True
          End If
          If bolComplete Then
            AnzFound = AnzFound + 1
            With Sheets("Cache")
              .Cells(AnzFound, 1) = FileName
              .Cells(AnzFound, 2) = dateInput
              .Cells(AnzFound, 3) = FirstNumber
              .Cells(AnzFound, 4) = SecondNumber
              .Cells(AnzFound, 5) = FirstValue
              .Cells(AnzFound, 6) = SecondValue
            End With
            dateInput = 0: FirstNumber = "": SecondNumber = "": FirstValue = 0: SecondValue = 0
            bolComplete = False
            bolMatch = False
          End If
        End If
      Next
      FileName = Dir
    Loop
  End If
End Sub

VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media
Code erstellt und getestet in Office 16 - mit VBAHTML 12.6.0

	A	B	C	D	E	F
1	Gruß Sepp
2
3

AW: Danke Sepp. Um eine Abfrage erweitern?

24.01.2019 08:58:56

MarC

Hm das habe ich glaube ich sogar so gemacht und angepasst, aber es nichts passiert. Und jetzt erhalte ich bei deinem Code die Meldung Laufzeitfehler 13 - Typen unverträglichkeit

AW: Danke Sepp. Um eine Abfrage erweitern?

24.01.2019 11:06:26

Sepp

Hallo Marc,
welche Zeile wird markiert? Welchen Wert haben die betroffenen Variablen?

	A	B	C	D	E	F
1	Gruß Sepp
2
3

AW: Danke Sepp. Um eine Abfrage erweitern?

24.01.2019 12:05:27

MarC

Ich weiß nicht ob es richtig ist aber ich habe jetzt mal den Haltepunkt an unterschiedliche Stellen gesetzt und bin dabei auf bolComplete = True gestoßen. Als wert Stand false = right da
Kann das stimmen?

AW: Danke Sepp. Um eine Abfrage erweitern?

24.01.2019 13:08:32

Sepp

Hallo Marc,
kannst du die komplette Textdatei hochladen bei der die Fehlermeldung erscheint?

	A	B	C	D	E	F
1	Gruß Sepp
2
3

AW: Danke Sepp. Um eine Abfrage erweitern?

24.01.2019 14:22:48

MarC

Ich kann dir die Daten nur per E-Mail schicken. Ich versteh das nicht. Der Code sucht doch Zeilenweise nach dem Begriff unabhängig wann er kommt oder? Wenn der Begriff gefunden wurde werden die geforderten Daten rauskopiert oder?

AW: Danke Sepp. Um eine Abfrage erweitern?

24.01.2019 14:51:07

Sepp

Hallo Marc,
dann brauche ich deine Mail-Adresse!

	A	B	C	D	E	F
1	Gruß Sepp
2
3

AW: Danke Sepp. Um eine Abfrage erweitern?

25.01.2019 10:22:21

MarC

Ich glaube ich habe den Fehler gefunden, aber beheben kann ich ihn nicht. Als erstes wird ja nach zwei Seriennummern gesucht das Problem hierbei ist wenn die Zeile ready to start gefunden wurde kann es sein das in der Zeile 1 oder 2 Seriennummern stehen und in Abhängigkeit davon kann in der nächsten Zeile die gesucht werden soll auch nur 1 oder 2 Messwerte vorhanden sein.
Ich habe mal ein Text file hochgeladen das beide Varianten enthält. In der ersten Zeile steht nur eine Seriennummer "G2U" und somit in der Zeile 9 auch nur ein Messwert. Ich glaube man müsste im Vorfeld eine Abfrage starten ob 1 oder 2 Werte vorhanden sind also denk ich mir jetzt.
Dateien:
https://www.herber.de/bbs/user/127098.txt
https://www.herber.de/bbs/user/127099.doc

AW: Danke Sepp. Um eine Abfrage erweitern?

25.01.2019 16:51:26

Sepp

Hallo Marc,
dann sollte es so laufen.

Sub findWordinTXT()
  Dim sWord1 As String, sSearchPath As String, sPath As String, FileName As String, sword2 As String
  Dim AnzFound As Integer, FF As Integer, findString As String
  Dim InputData As String, varInput As Variant, lngI As Long, lngJ As Long, strLine() As String
  Dim dateInput As Date, FirstNumber As String, SecondNumber As String, FirstValue As Variant, SecondValue As Variant
  Dim bolMatch As Boolean, bolComplete As Boolean
  'Wort nach dem gesucht werden soll 
  sWord1 = "Ready to start"
  sword2 = "Uut passed"
  findString = "G2U"  ' gesuchte Seriennummer - Anpassen! 
  'Suche nach allen Textdateien im Verzeichnis c:\temp\xl 
  sSearchPath = "C:\Users\*.txt"
  sPath = "C:\Users\"
  FileName = Dir(sSearchPath)
  If FileName <> "" Then
    FF = FreeFile
    Do While FileName <> ""
      Open sPath & FileName For Input As #FF
      Do While Not EOF(FF)
        Line Input #FF, InputData
        Redim Preserve strLine(lngI)
        strLine(lngI) = Replace(InputData, "*", "")
        lngI = lngI + 1
      Loop
      Close #FF
      For lngI = 0 To Ubound(strLine)
        If Not bolMatch Then
          If InStr(1, strLine(lngI), sWord1) > 0 Then
            bolMatch = True
            varInput = Split(strLine(lngI), "##")
            dateInput = CDate(Left(varInput(0), 19))
            For lngJ = 1 To Ubound(varInput)
              If varInput(lngJ) Like findString & "##########*" Then
                If Len(FirstNumber) = 0 Then
                  FirstNumber = varInput(lngJ)
                ElseIf Len(SecondNumber) = 0 Then
                  SecondNumber = varInput(lngJ)
                  Exit For
                End If
              End If
            Next
          End If
        ElseIf bolMatch Then
          If InStr(1, strLine(lngI), sword2) > 0 Then
            varInput = Split(strLine(lngI), "##")
            FirstValue = CDbl(Trim(Replace(varInput(5), ".", ",")))
            If Len(SecondNumber) Then SecondValue = CDbl(Trim(Replace(varInput(20), ".", ",")))
            bolComplete = True
          End If
          If bolComplete Then
            AnzFound = AnzFound + 1
            With Sheets("Cache")
              .Cells(AnzFound, 1) = FileName
              .Cells(AnzFound, 2) = dateInput
              .Cells(AnzFound, 3) = FirstNumber
              .Cells(AnzFound, 4) = SecondNumber
              .Cells(AnzFound, 5) = FirstValue
              .Cells(AnzFound, 6) = SecondValue
            End With
            dateInput = 0: FirstNumber = "": SecondNumber = "": FirstValue = "": SecondValue = ""
            bolComplete = False
            bolMatch = False
          End If
        End If
      Next
      FileName = Dir
    Loop
  End If
End Sub

VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media
Code erstellt und getestet in Office 16 - mit VBAHTML 12.6.0

Den Beginn der seriennummer kannst du jetzt im Code einfach ändern, siehe Kommentar.

	A	B	C	D	E	F
1	Gruß Sepp
2
3

AW: Danke Sepp. Um eine Abfrage erweitern?

25.01.2019 20:59:33

MarC

Danke für deine Hilfe Sepp,
jetzt würde ich gerne sagen supi es funktioniert und ich werde dich nicht mehr nerven, aber bei Zeile 2385 hat der Code abgebrochen weil sich da die Textzeile der Seriennummern auf einmal ändert hat. Und zwar ist es so. Es stehen mal 1 oder 2 Seriennummern da das habe ich dir ja geschrieben. Der Witz ist nur das es anscheinend 3 Varianten gibt wie die Seriennummern in die Textzeile geschrieben werden können. Zwei Varianten hast du schon erschlagen bei der dritten Variante ist es so das die einzelne Seriennummer nicht links steht sondern rechts da wo die zweite steht.
Die drei Varianten habe ich im Textfile abgebildet.
https://www.herber.de/bbs/user/127151.txt
Zur Erklärung warum das so ist das die Seriennummern links oder rechts stehen. Bei dem Protokoll geht es um einen Messplatz der zwei Slots hat. Das bedeutet das ein Bauteil links, rechts oder links und rechts eingelegt werden können und deswegen werden die Seriennummern anscheinend auch in dieser Abhängigkeit links oder rechts (sollte nur eins einzeln getestet werden) im Protokoll aufgeführt.

AW: Danke Sepp. Um eine Abfrage erweitern?

25.01.2019 21:13:25

Sepp

Hallo Marc,
1. ein Textfile ohne Werte zum Auslesen ist sinnlos!
2. Welches Genie hat die Mess Software erstellt, am besten sollte er ein Auswerte-Tool zur Verfügung stellen.
3. Wie viele änderungen kommen noch?

	A	B	C	D	E	F
1	Gruß Sepp
2
3

AW: Danke Sepp. Um eine Abfrage erweitern?

25.01.2019 21:34:24

MarC

Keine Ahnung wer es war Sepp aber ich finde es auch nicht sehr geistreich. Lass es sein Sepp es würde mir schon helfen wenn die ganze Zeile in der die Seriennummern stehen in die Spalte B geschrieben und die Zeile der dazu gehörigen Messwerte in die Spalte C geschrieben werden.
Die einzelnen Seriennummern und Messwerte werde ich dann mit Formeln ermitteln das habe ich nämlich gerade versucht und klappt relativ gut ich muss die Formeln nur für verschiedene Varianten anpassen.
=TEIL(D991;SUCHEN("##00000.00##";D991)-35;5)
=TEIL(D991;SUCHEN("##00000.00##";D991)+115;5)
usw.
Die Zeilen mit den Seriennummern habe ich so ermittelt:

Sub findWordinTXT()
Dim sWord1 As String, sPath1 As String, sSearchPath1 As String, FileName1 As String,  _
InputData1
Dim AnzFound1 As Double
AnzFound1 = 0
sWord1 = "Ready"
sWord2 = "##Uut"
sSearchPath1 = "C:\Users\*.txt"
sPath1 = "C:\Users\"
FileName1 = Dir(sSearchPath1)
If FileName1  "" Then
Do While FileName1  ""
Open sPath1 & FileName1 For Input As #1
Do While Not EOF(1)
Line Input #1, InputData1
If InStr(1, InputData1, sWord1) > 0 Then
AnzFound1 = AnzFound1 + 1
Sheets("Cache").Cells(AnzFound1, 1) = FileName1
Sheets("Cache").Cells(AnzFound1, 2) = InputData1
End If
Loop
Close #1
FileName1 = Dir
Loop
End If
End Sub

Jetzt müsste der Code noch um die Zeile der Messwerte erweitert werden. Den rest würde ich mit Formeln machen