✔ RegEx bestimmten Wert auslesen

[bustue]

Hallo Fachleute,
ich habe eine Textdatei die 3 Seiten umfasst. Hieraus möchte ich Daten in Excel einlesen.
Folgende Zeichenkette taucht jeweils auf eine Seite auf.
Position Materialbeschreibung Menge Einheit Preis pro Einheit Nettobetrag

10 M.Gewindeb. M D371B HSSEM10 VA 5,00 ST 10,92 / 1 ST 54,60

FORUM

Ihre Materialnummer: 4214404285
An die Materialnummer komme ich ran

'Ártikelnr auslesen
        regex.Pattern = "Materialnummer: ([^\r\n]+)"
        Set matches = regex.Execute(strTXT)
        If matches.Count > 0 Then
            rngLastRow.Cells(1, 1).Value = matches(0).SubMatches(0) 'Artikelnr in Spalte A speichern
        End If

Wie komme ich an die Menge (hier fett markiert) heran. Ich habe schon einiges zu den regulären Ausdrücken gelesen, bekomme aber das Pattern einfach nicht hin.
Könnte mir da jemand behilflich sein.

MfG
bustue

 

[Bratkartoffel]

Hi,

wie sind die Spalten voneinander getrennt? Fixe Breite pro Spalte? Tabulatoren?

Grüsse,
BK

 

[Yaslaw]

In deinem Beispiel würde es so funktionieren -> Test auf regex101.com

regex.Pattern = "\s(\d+,\d{2})\s"
regex.global = False
If regex.test(strTXT) Then
    preis = regex.execute(strTXT)(9).SubMatches(0)
End If

 

[bustue]

Hallo BK,
Ich lese die Daten aus einer PDF-Datei mit Hilfe von PDFtoText aus.

Sub PDF2Excel()
    Dim i As Integer
    Dim strCMDLine As String, strTXT As String
    Dim FSO As Object, objSFold As Object, objWks As Object, WSHShell As Object, file As Object, rngLastRow As Range
    Dim colPFiles As New Collection, colTFiles As New Collection, regex As Object
   
    Set WSHShell = CreateObject("WScript.Shell")
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set regex = CreateObject("vbscript.regexp")
    regex.MultiLine = True
    Set objSFold = FSO.GetFolder(ThisWorkbook.Path)
   
    strCMDLine = """" & ThisWorkbook.Path & "\pdftotext.exe"" -raw -layout -table "
       
    For Each file In objSFold.Files                                  ' alle Dateien einlesen
        If Right(file.Path, 4) = ".pdf" Then colPFiles.Add file.Path  ' nur *.pdf
    Next
   
    For i = 1 To colPFiles.Count
         WSHShell.Run strCMDLine & """" & colPFiles.Item(i) & """", 0, True
    Next
   
    For Each file In objSFold.Files                                  ' wieder alles einlesen
        If Right(file.Path, 4) = ".txt" Then colTFiles.Add file.Path  ' nur *.txt
    Next
   
    Set objWks = Worksheets(1)
    Set rngLastRow = objWks.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
   
    For i = 1 To colTFiles.Count
     arrValues = GetMatchValues(FSO.OpenTextFile(colTFiles.Item(i)).ReadAll)
   
    If IsArray(arrValues) Then
        intNextLine = Cells(Rows.Count, "A").End(xlUp).Row + 1
        Cells(intNextLine, "A").Resize(UBound(arrValues, 1) + 1, UBound(arrValues, 2) + 1).Value = arrValues
    Else
        'keine treffer
    End If
    'Ártikelnr auslesen
        regex.Pattern = "Materialnummer: ([^\r\n]+)"
        Set matches = regex.Execute(strTXT)
        If matches.Count > 0 Then
            rngLastRow.Cells(1, 1).Value = matches(0).SubMatches(0) 'Artikelnr in Spalte A speichern
        End If

Danke im Voraus schon für Deine Hilfe

 

[bustue]

Hallo Yaslaw, danke für Deine schnelle Hilfe, jedoch erhalte ich in der Zeile

  preis = regex.Execute(strTXT)(9).SubMatches(0)

den Debugger.

 

[Yaslaw]

Sollte 0 und nicht 9 heissen....

 

[bustue]

Hallo Yaslaw,
Top, die Sache funktioniert jetzt. Eine Frage hätte ich da noch wie bekomme ich es hin, das die Daten der Textdatei

 

[Yaslaw]

Hallo Yaslaw,
Top, die Sache funktioniert jetzt. Eine Frage hätte ich da noch wie bekomme ich es hin, das die Daten der Textdatei

Leider hast du nur den halben Text geschickt. Was soll mit den Daten?

 

[bustue]

Hallo Yaslaw,
danke, das Du meiner annimmst. Das Problem, welches ich noch habe, ist, das Ich in der Textdatei mehrere Positionen
habe, aber nur die erste Position ausgelesen werden. (Die Textdatei wurde aus 3 Seiten PDF konvertiert) Je Seite eine Position. Mein bisheriger Code hierfür:

Sub PDF2Excel()
    Dim i As Integer
    Dim strCMDLine As String, strTXT As String
    Dim FSO As Object, objSFold As Object, objWks As Object, WSHShell As Object, file As Object, rngLastRow As Range
    Dim colPFiles As New Collection, colTFiles As New Collection, regex As Object
    
    Set WSHShell = CreateObject("WScript.Shell")
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set regex = CreateObject("vbscript.regexp")
    regex.MultiLine = True
    Set objSFold = FSO.GetFolder(ThisWorkbook.Path)
    
    strCMDLine = """" & ThisWorkbook.Path & "\pdftotext.exe"" -raw -layout -table "
        
    For Each file In objSFold.Files                                  ' alle Dateien einlesen
        If Right(file.Path, 4) = ".pdf" Then colPFiles.Add file.Path  ' nur *.pdf
    Next
    
    For i = 1 To colPFiles.Count
         WSHShell.Run strCMDLine & """" & colPFiles.Item(i) & """", 0, True
    Next
    
    For Each file In objSFold.Files                                  ' wieder alles einlesen
        If Right(file.Path, 4) = ".txt" Then colTFiles.Add file.Path  ' nur *.txt
    Next
    
    Set objWks = Worksheets(1)
    Set rngLastRow = objWks.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
    
    For i = 1 To colTFiles.Count
        strTXT = FSO.OpenTextFile(colTFiles.Item(i)).ReadAll
        
        'Ártikelnr auslesen
        regex.Pattern = "Materialnummer: ([^\r\n]+)"
        Set matches = regex.Execute(strTXT)
        If matches.Count > 0 Then
            rngLastRow.Cells(1, 1).Value = matches(0).SubMatches(0) 'Artikelnr in Spalte A speichern
        End If
               
        'Menge auslesen
        regex.Pattern = "\s(\d+,\d{2})\s"
        Set matches = regex.Execute(strTXT)
        If matches.Count > 0 Then
            rngLastRow.Cells(1, 2).Value = matches(0).SubMatches(0) 'Menge in Spalte B speichern
        End If
        'regex.Pattern = "\s(\d+,\d{2})\s"
        'regex.Global = False
        'If regex.test(strTXT) Then
        'preis = regex.Execute(strTXT)(0).SubMatches(0)
        'End If
        
        
        
        Set rngLastRow = rngLastRow.Offset(1, 0)
        'Textdatei löschen
       ' Kill colTFiles.Item(i)
    Next
    Set FSO = Nothing
    Set regex = Nothing
    Set WSHShell = Nothing
    Set objSFold = Nothing
End Sub

Ist es möglich Dich deswegen zu bemühen?
MFG
bustue

 

[Yaslaw]

Kannst du mal ein Testfile hochladen?