Ok, dann probier es mal damit:
Option Explicit
Sub Test()
Dim rngCell As Excel.Range
Dim objItem As VBA.Collection
Dim ts As Object 'VBScript.TextStream
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
'1# read file content
With CreateObject("Scripting.FileSystemObject")
If .FileExists(strFile) Then
Set ts = .GetFile(strFile).OpenAsTextStream(1) '1=ForReading
strFileContent = ts.ReadAll
ts.Close
End If
End With
'#2 fetch specific values from file content and write them into a worksheet
With Worksheets("Tabelle1").Range("A2:E2")
.CurrentRegion.Clear
.Font.Bold = True
'parameter values we want to read
.Value = Array("O/F", "P, BAR", "T, K", "CSTAR, M/SEC", "Isp, M/SEC")
.Offset(-1).EntireRow.Hidden = True
'index (1st, 2nd, ...) of each parameter value we want
.Offset(-1).Value = Array(1, 1, 1, 1, 2)
For Each rngCell In .Cells
lngRowOffset = 1 '(re-)set offset for first data row
For Each objItem In GetParameterValues(rngCell.Text, strFileContent)
'return param. value by it's index
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
'helper function
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
Wenn es nicht so funktioniert wie erwartet, dann lad' bitte mal eine Beispieldatei auf einem FileHoster deiner Wahl noch und verlink die Datei hier.
Bei meinem Beispiel kommt - mit zwei diese Abschnitte - folgendes heraus:
O/F |
P, BAR |
T, K |
CSTAR, M/SEC |
Isp, M/SEC |
1 |
10 |
1112,65 |
1155,8 |
1398,3 |
1,1 |
11 |
1113,65 |
1255,8 |
1498,3 |
Die zweite Datenreihe ist von mir im der Datei hinzugefügt und Werte verändert worden.
Grüße
|