Option
Explicit
Private
Type MinMax
Min
As
Single
Max
As
Single
End
Type
Public
Sub
Import()
Dim
rngTarget
As
Excel.Range
Dim
vntFilenames
As
Variant
Dim
vntFilename
As
Variant
vntFilenames = Application.GetOpenFilename(
"Textdatei (*.txt),*.txt"
, Title:=
"Messdatei auswerten"
, MultiSelect:=
True
)
If
VarType(vntFilename) = vbBoolean
Then
Exit
Sub
For
Each
vntFilename
In
vntFilenames
With
ThisWorkbook.Worksheets.Add()
.Name = Right$(vntFilename, Len(vntFilename) - InStrRev(vntFilename, "\"))
Set
rngTarget = .Range(
"A1"
)
End
With
Call
ImportFromFile(
CStr
(vntFilename), rngTarget)
Next
End
Sub
Public
Sub
ImportFromFile(Filename
As
String
, Target
As
Excel.Range)
Call
Workbooks.OpenText( _
Filename:=Filename, _
ConsecutiveDelimiter:=
True
, _
Semicolon:=
True
)
Dim
rngData
As
Excel.Range
Dim
rngMass
As
Excel.Range
Dim
rngSpeed
As
Excel.Range
Dim
udtMass
As
MinMax
Dim
udtSpeed
As
MinMax
Dim
nOK
As
Long
Dim
i
As
Long
With
ActiveWorkbook.Worksheets(1)
udtMass.Min = .Range(
"B3"
).Value + .Range(
"B4"
).Value
udtMass.Max = .Range(
"B3"
).Value + .Range(
"B5"
).Value
udtSpeed.Min = .Range(
"B7"
).Value + .Range(
"B8"
).Value
udtSpeed.Max = .Range(
"B7"
).Value + .Range(
"B9"
).Value
Set
rngData = .Range(
"A14"
, .Cells.SpecialCells(XlCellType.xlCellTypeLastCell))
End
With
For
i = 1
To
rngData.Rows.Count
Set
rngMass = rngData.Cells(i, 1)
Set
rngSpeed = rngData.Cells(i, 2)
If
(udtMass.Min <= rngMass.Value
And
rngMass.Value <= udtMass.Max
Or
rngMass.Value =
""
) _
And
(udtSpeed.Min <= rngSpeed.Value
And
rngSpeed.Value <= udtSpeed.Max
Or
rngSpeed.Value =
""
) _
Then
nOK = nOK + 1
End
If
Next
Target.Cells(1, 1).Value =
"Anzahl Messungen:"
Target.Cells(1, 2).Value = rngData.Rows.Count
Target.Cells(2, 1).Value =
"OK:"
Target.Cells(2, 2).Value = nOK
Target.Cells(3, 1).Value =
"Nicht ok:"
Target.Cells(3, 2).Value = rngData.Rows.Count - nOK
Target.Resize(, 2).EntireColumn.AutoFit
Call
rngData.Worksheet.Parent.Close(SaveChanges:=
False
)
Set
Target = Target.Offset(3)
End
Sub