Thema Datum  Von Nutzer Rating
Antwort
28.05.2021 17:38:34 Andreas
NotSolved
28.05.2021 18:11:36 Gast3180
*****
NotSolved
29.05.2021 21:02:10 Andreas
NotSolved
30.05.2021 03:34:00 Gast58663
*****
NotSolved
30.05.2021 12:38:47 Gast47805
NotSolved
30.05.2021 14:40:32 Gast89593
NotSolved
30.05.2021 15:15:09 Andreas
NotSolved
30.05.2021 15:24:40 Gast38157
NotSolved
30.05.2021 17:24:20 Gast37156
NotSolved
30.05.2021 17:43:50 Gast41263
NotSolved
30.05.2021 19:30:09 Andreas
NotSolved
30.05.2021 19:52:58 Andreas
NotSolved
Rot Rot Textdatei über VBA einlesen und Werte vergleichen
31.05.2021 20:53:26 Gast817
NotSolved

Ansicht des Beitrags:
Von:
Gast817
Datum:
31.05.2021 20:53:26
Views:
873
Rating: Antwort:
  Ja
Thema:
Textdatei über VBA einlesen und Werte vergleichen
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
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


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
28.05.2021 17:38:34 Andreas
NotSolved
28.05.2021 18:11:36 Gast3180
*****
NotSolved
29.05.2021 21:02:10 Andreas
NotSolved
30.05.2021 03:34:00 Gast58663
*****
NotSolved
30.05.2021 12:38:47 Gast47805
NotSolved
30.05.2021 14:40:32 Gast89593
NotSolved
30.05.2021 15:15:09 Andreas
NotSolved
30.05.2021 15:24:40 Gast38157
NotSolved
30.05.2021 17:24:20 Gast37156
NotSolved
30.05.2021 17:43:50 Gast41263
NotSolved
30.05.2021 19:30:09 Andreas
NotSolved
30.05.2021 19:52:58 Andreas
NotSolved
Rot Rot Textdatei über VBA einlesen und Werte vergleichen
31.05.2021 20:53:26 Gast817
NotSolved