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 'value ist neg.
udtMass.Max = .Range("B3").Value + .Range("B5").Value
udtSpeed.Min = .Range("B7").Value + .Range("B8").Value 'value ist neg.
udtSpeed.Max = .Range("B7").Value + .Range("B9").Value
'Datenbereich
'in 1. Spalte steht das Gewicht
'in 2. Spalte steht die Geschwindigkeit
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
Alternativ könnte man sich die ermittelten Werte auch zurückgeben lassen und außerhalb der Sub ImportFromFile wohin schreiben.
Grüße
|