Option Explicit
Sub Test()
Dim rngCell As Excel.Range
Dim objItem As VBA.Collection
Dim ts As Object
Dim strFileContent As String
Dim strFile As String
Dim lngRowOffset As Long
strFile = Application.GetOpenFilename("TXT-Datei,*.txt", , "Irgendwas öffnen ...")
If strFile = CStr(False) Then Exit Sub
With CreateObject("Scripting.FileSystemObject")
If .FileExists(strFile) Then
Set ts = .GetFile(strFile).OpenAsTextStream(1)
strFileContent = ts.ReadAll
ts.Close
End If
End With
With Worksheets("Tabelle1").Range("A2:E2")
.CurrentRegion.Clear
.Font.Bold = True
.Value = Array("O/F", "P, BAR", "T, K", "CSTAR, M/SEC", "Isp, M/SEC")
.Offset(-1).EntireRow.Hidden = True
.Offset(-1).Value = Array(1, 1, 1, 1, 2)
For Each rngCell In .Cells
lngRowOffset = 1
For Each objItem In GetParameterValues(rngCell.Text, strFileContent)
On Error Resume Next
rngCell.Offset(lngRowOffset).Value = Val(objItem(rngCell.Offset(-1).Value))
If Err.Number <> 0 Then rngCell.Offset(lngRowOffset).Value = CVErr(XlCVError.xlErrValue)
On Error GoTo 0
lngRowOffset = lngRowOffset + 1
Next
Next
.EntireColumn.HorizontalAlignment = XlHAlign.xlHAlignRight
.EntireColumn.AutoFit
End With
End Sub
Private Function GetParameterValues(ByVal Name As String, Expression As String) As VBA.Collection
Dim colValues As VBA.Collection
Dim vntItem As Variant
Dim vntSubItem As Variant
With CreateObject("VBScript.RegExp")
.IgnoreCase = True
.MultiLine = True
.Global = True
.Pattern = "\b" & Name & "\s*=?\s*((?:\s*\d+(?:\.\d+)?)+)"
Set colValues = New VBA.Collection
For Each vntItem In .Execute(Expression)
vntItem = vntItem.SubMatches(0)
While InStr(1, vntItem, " ") > 0
vntItem = Replace$(vntItem, " ", " ")
Wend
vntItem = Split(vntItem, " ")
Call colValues.Add(item:=New VBA.Collection)
For Each vntSubItem In vntItem
Call colValues(colValues.Count).Add(item:=vntSubItem)
Next
Next
Set GetParameterValues = colValues
End With
End Function