HERBERS Excel-Forum - das Archiv
Bewerten Sie hier bitte das Excel-Portal
Einige Stellen aus TXT-File auslesen
Andre´

Hallo alle zusammen,
ich möchte einige Stellen aus einer TXT- Datei in ein Excelfile schreiben.
Dazu soll aus dem angehängten TXT-File (Das Orginal TXT-File hat ca.50000 Zeilen):
https://www.herber.de/bbs/user/66138.txt
das was sich hinter dem Suchkriterium:
Purchase Order, Item, Supplier, Unit Cost, Start Effective und End Effective befindet ausgelesen werden.
Nachfolgend der Output in Excel ohne die Zeile 7 (Zeile 7 zeigt die Stellen an die ausgelesen werden sollen)
Tabelle1

 ABCDEF
2Purchase OrderItemSupplierUnit CostStart EffectiveEnd Effective
311aaaaaa111 111 111      e11111111,913630.04.200528.02.2006
422aaaaaa222 222 222      e22222222,913627.05.200528.03.2006
533aaaaaa333 333 333      e33333333,913628.06.2005 
6      
7zwischen 18 bis 28zwischen 18 bis 36zwischen 18 bis 24zwischen 17 bis 47zwischen 62 bis 70zwischen 62 bis 70


Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4
Die Suchkriterien tauchen in regelmäßigen Zeilenabstand erneut auf.
Der Zeilenabstand zwischen dem ersten Kriterium (Purchase Order) und dem letzten (End Effective) pro Item ist immer gleich.
Es kann auch passieren, dass nach dem Suchkriterium nicht steht wie es im Bsp.nach End Effective der Fall ist (Position 62 der Zeile 116) dann soll die Zelle leer bleiben.
Ich hoffe, mir kann jemand behilflich sein.
Vielen Dank im Voraus!
MFG Andre

AW: Einige Stellen aus TXT-File auslesen
Josef

Hallo André,
probier mal.
https://www.herber.de/bbs/user/66141.xls
Gruß Sepp

AW: Einige Stellen aus TXT-File auslesen
Andre´

Hallo Sep,
danke für Deine Hilfe.
Funktioniert noch nicht zu 100%, weil für die Item Spalte 18 Zeichen (momentan 11) und für die Supplier Spalte nur 6 Zeichen (momentan 13) eingelesen werden.
Erhalte für die erste Item: 111 111 111
anstatt: 111 111 111 e
Da das ganze auch in Excel 2007 funktionieren soll, dauert es natürlich recht lang,
bis alles zugeordnet wird.
Kannst Du mir bitte nochmals unter die Arme greifen.
MFG Andre
PS. versuche gerade den Code zu verstehen und teste natürlich selbst dahinter zu kommen
AW: Einige Stellen aus TXT-File auslesen
Josef

Hallo André,
das ist kein Problem.
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub importText()
  Dim strFile As String, varText As Variant, varInput As Variant
  Dim lngRow As Long, lngIndex As Long, intFF As Integer
  Dim strTmp As String, intPos As Integer
  
  strFile = Application.GetOpenFilename("Textdateien (*.txt),*.txt")
  
  If strFile = CStr(False) Then Exit Sub
  
  varText = Range("A1:F1")
  Range("A2:F" & Rows.Count) = ""
  Range("A2:F" & Rows.Count).NumberFormat = "General"
  varInput = Range("A2:F" & Rows.Count)
  
  intFF = FreeFile
  
  Open strFile For Input As #intFF
  Do While Not EOF(intFF)
    Line Input #intFF, strTmp
    For lngIndex = 1 To UBound(varText, 2)
      intPos = InStr(Application.Max(1, intPos), strTmp, varText(1, lngIndex))
      If intPos > 0 Then
        If lngIndex = 1 Then lngRow = lngRow + 1
        If varInput(lngRow, lngIndex) = "" Then
          varInput(lngRow, lngIndex) = Trim(Mid(strTmp, intPos + Len(varText(1, lngIndex)) + 1, IIf(lngIndex < 4, 30, 14)))
          If IsNumeric(varInput(lngRow, lngIndex)) Then
            varInput(lngRow, lngIndex) = varInput(lngRow, lngIndex) * 1
          ElseIf IsDate(varInput(lngRow, lngIndex)) Then
            varInput(lngRow, lngIndex) = CDate(varInput(lngRow, lngIndex))
          Else
            varInput(lngRow, lngIndex) = ReplaceMulti(varInput(lngRow, lngIndex), " ", " ")
          End If
        End If
      End If
    Next
  Loop
  Close #intFF
  
  Range("A2:F" & Rows.Count) = varInput
  Range("A1:F1").EntireColumn.AutoFit
End Sub

Private Function ReplaceMulti(ByVal Expression As String, ByVal Find As String, ByVal Repl As String) As String
  ReplaceMulti = Expression
  Do While InStr(1, ReplaceMulti, Find) > 0
    ReplaceMulti = Replace(ReplaceMulti, Find, Repl)
  Loop
End Function

Gruß Sepp

AW: Einige Stellen aus TXT-File auslesen
Andre´

Hallo Sepp
Danke für Deine Überarbeitung.
Ich werde die Lösung von Udo bevorzugen, weil dieser Code schneller ist.
Nochmals Vielen DANK!
MFG Andre
AW: Einige Stellen aus TXT-File auslesen
Uduuh

Hallo,
teste mal: Sub ttt() Dim sText As String, arrText, i As Long, lRow As Long Open "f:\66138.txt" For Input As #1 'anpassen sText = Input(LOF(1), 1) Close 1 arrText = Split(sText, vbLf) For i = 0 To UBound(arrText) If InStr(arrText(i), "Purchase Order:") > 0 Then lRow = lRow + 1 Cells(lRow, 1) = Mid(arrText(i), 18, 11) End If If Left(Trim(arrText(i)), 5) = "Item:" Then Cells(lRow, 2) = Mid(Trim(arrText(i)), 7, 19) End If If Left(Trim(arrText(i)), 9) = "Supplier:" Then Cells(lRow, 3) = Mid(Trim(arrText(i)), 11, 6) End If If Left(Trim(arrText(i)), 10) = "Unit Cost:" Then Cells(lRow, 4) = CDbl(Mid(Trim(arrText(i)), 12, 10)) End If If InStr(arrText(i), "Start Effective:") > 0 Then Cells(lRow, 5) = CDate(Mid(arrText(i), 62, 8)) End If If InStr(arrText(i), "End Effective:") > 0 Then If Len(Trim(Mid(arrText(i), 62, 8))) <> 8 Then Else Cells(lRow, 6) = CDate(Mid(arrText(i), 62, 8)) End If End If Next End Sub Gruß aus’m Pott
Udo

AW: Einige Stellen aus TXT-File auslesen
Andre´

Hallo Udo,
auch Dir recht vielen Dank.
Mit Deinem Bsp. geht es auch in Excel 2007 meklich schneller.
Auch hier waren 19 Stellen in der Item- Spalte, dies habe ich aber selbst geändert.
Mein Problem ist hiermit gelöst.
Nochmals Vielen DANK an Sepp und Udo.
MFG Andre