PDA

Vollständige Version anzeigen : csv-Import - Messergebnisse zuordnen und auswerten


wuumbs
20.09.2016, 10:06
Hallo zusammen,

ich versuche aktuell einen kleinen VBA Code auf die Beine zu stellen, um mit Excel Messergebnisse, die in csv-Dateien vorliegen, auszuwerten.
Der Import der csv-Datei klappt problemlos. Die Schwierigkeit ist nun die Auswertung der Messergebnisse.

Nach dem Datei-Import liegen drei Spalten vor (siehe Anhang):
Time (ms), X und Y

Nun kurz eine Erläuterung zum Ablauf der Messung und dem Messschrieb.
Wenn keine Messung durchgeführt wird, wird ein "unplausibles" Signal aufgezeichnet, das durch einen sehr niedrigen X-Wert (kleiner -1000) definiert ist. Sobald also ein X-Wert, der größer ist als -1000 in der Spalte steht, beginnt eine Messung.
In einer Datei werden unterschiedlich viele Messungen aufgezeichnet, die unterschiedlich viele Messwerte beinhaltet.

Ich würde jetzt sehr gerne in Spalte D den Messungen eine Zahl zuweisen (Messung 1, Messung 2, Messung 3, etc.) und anschließend sämtliche Zeilen mit unplausiblen Signalen löschen.

Es müsste also eine Abfrage programmiert werden, die zunächst den ersten plausiblen Werten (X-Wert größer als -1000) die Messung 1 zuordnet. Sobald der erste unplausible X-Wert erscheint, ist in der Zeile davor die Messung 1 abgeschlossen. Nach diesem Satz unplausibler Werte, mit dem Beginn des ersten plausiblen Wertes, startet die Messung 2.
Nach der Zuordnung sollen dann alle unplausiblen Werte gelöscht werden.

Bislang habe ich die Zuordnung der Messungen immer händisch eingetragen und anschließend ein Makro verwendet, das die Zeilen löscht. Da ich allerdings noch sehr viele Messschriebe auswerten muss, macht es definitiv Sinn arbeit in einen Code zu investieren.

Mein aktueller Löschcode sieht wie folgt aus:


Sub ZeilenBereinigen()
Dim wks As Worksheet
Dim lngLetzte As Long, lngI As Long
Application.ScreenUpdating = False
Set wks = ThisWorkbook.Worksheets("Tabelle1")
With wks
lngLetzte = .Range("A1048576").End(xlUp).Row
For lngI = lngLetzte To 2 Step -1 'wenn keine Überschrift To 1 step -1
If .Range("B" & lngI).Value < -1000 Then
.Rows(lngI).Delete
End If
Next lngI
End With
Set wks = Nothing
Application.ScreenUpdating = True
End Sub


Habt ihr vielleicht Tipps & Tricks für mich wie ich das gewünscht umsetzen kann? Leider bin ich kein VBA-Experte... ich suche mir lediglich in Foren immer die nötigen Code-Bausteine zusammen.

Danke und liebe Grüße,
wuumbs

ASE
20.09.2016, 12:54
Hallo,
ich hoffe ich habe Dich richtig verstanden.

Sub ZeilenBereinigen()
Dim wks As Worksheet
Dim lngLetzte As Long, lngI As Long
Dim Anzahl As Long
Dim Messung As Boolean

Anzahl = 1
Application.ScreenUpdating = False
Set wks = ThisWorkbook.Worksheets("Tabelle1")
With wks
lngLetzte = .Range("A1048576").End(xlUp).Row
For lngI = lngLetzte To 2 Step -1 'wenn keine Überschrift To 1 step -1
If .Range("B" & lngI).Value > -1000 Then
If Messung Then
.Range("D" & lngI + 1).Value = "Messung-" & Anzahl
Anzahl = Anzahl + 1
Messung = False
End If
.Rows(lngI).Delete
Else
Messung = True
End If
Next lngI
End With
Set wks = Nothing
Application.ScreenUpdating = True
End Sub

xlph
20.09.2016, 13:51
Option Explicit

Public Sub MessungenErmittelnUndSaeubern()

Dim lngStartRow As Long
Dim lngLastRow As Long
Dim lngCounter As Long

Dim blnOutOfRange As Boolean

Dim avntData() As Variant
Dim iavntData1 As Long
Dim avntResult() As Variant

lngStartRow = 12

With Tabelle1

Application.ScreenUpdating = False

lngLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row

.Range("D" & lngStartRow & ":D" & lngLastRow).ClearContents

avntData() = .Range("B" & lngStartRow & ":B" & lngLastRow).Value

ReDim avntResult(LBound(avntData, 1) To UBound(avntData, 1), 1 To 1)

For iavntData1 = LBound(avntData, 1) To UBound(avntData, 1)
If avntData(iavntData1, 1) < -1000 Then
avntResult(iavntData1, 1) = False
blnOutOfRange = True
Else
If blnOutOfRange Then
lngCounter = lngCounter + 1
blnOutOfRange = False
End If
avntResult(iavntData1, 1) = lngCounter
End If
Next

With .Range("D" & lngStartRow).Resize(UBound(avntResult, 1))

.Value = avntResult()

If WorksheetFunction.CountIf(.Cells, False) > 0 Then
.SpecialCells(xlCellTypeConstants, xlLogical).EntireRow.Select
'.SpecialCells(xlCellTypeConstants, xlLogical).EntireRow.Delete
End If

End With

Application.ScreenUpdating = True

End With

End Sub

wuumbs
21.09.2016, 09:52
Vielen Dank für eure Hilfe!

Ich nutze jetzt den Code von xlph - funktioniert einwandfrei!

Gibt es jetzt eigentlich noch irgendwie die Möglichkeit mir für jede Messung automatisch ein Diagramm generieren zu lassen? Auf der X-Achse soll einfach fortlaufend die Anzahl der Messwerte aufgeführt werden (z.B. Messung 1 hat 100 einzelne Messwerte, auf der X-Achse wäre dann 1. Messwert, 2. Messwert 3. Messwert etc.) und auf der Y-Achse benötige ich dann den Y-Wert aus Spalte C.

Die Schwierigkeit ist hier natürlich wieder, dass ich immer unterschiedlich viele Messungen habe und innerhalb der Messungen gibt es unterschiedlich viele Messwerte.

Über erneute Hilfe würde ich mich wirklich sehr freuen!

Liebe Grüße,
wuumbs

xlph
21.09.2016, 13:21
...der o.a. Prozedur nachschalten.

Public Sub DiagrammeErzeugen()

Dim lngStartRow As Long
Dim lngLastRow As Long

Dim lngChartsCount As Long
Dim lngChartCnt As Long

Dim cht As Chart
Dim shp As Shape

lngStartRow = 12

With Tabelle1

Application.ScreenUpdating = False

lngLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row

With .Range("A" & lngStartRow - 1 & ":D" & lngLastRow)

lngChartsCount = WorksheetFunction.Max(.Columns(4))

For lngChartCnt = 1 To lngChartsCount

Set shp = .Worksheet.Shapes.AddChart

shp.Name = "chtMessung" & lngChartCnt

With .Worksheet.Range("F2").Offset((lngChartCnt - 1) * 10).Resize(10, 10)
shp.Left = .Left
shp.Top = .Top
shp.Width = .Width
shp.Height = .Height
End With

Set cht = shp.Chart

cht.ChartType = xlLine
cht.SetSourceData _
Source:=Range(.Cells(WorksheetFunction.Match(lngChartCnt, .Columns(4), 0), 3), _
.Cells(WorksheetFunction.Match(lngChartCnt, .Columns(4), 1), 3)), _
PlotBy:=xlColumns

cht.HasTitle = True
cht.ChartTitle.Text = "Measurement " & lngChartCnt

With cht.SeriesCollection(1)
With .Format.Line
.Weight = 1.5
.ForeColor.RGB = RGB(192, 0, 0)
End With
End With

If cht.HasLegend Then cht.Legend.Delete

Set shp = Nothing
Set cht = Nothing

Next

End With

Application.ScreenUpdating = True

End With

End Sub

wuumbs
21.09.2016, 13:59
Hallo!

Danke für deine Rückmeldung und schnelle Hilfe.
Habe den Code jetzt einfach mittels Copy & Paste hinter dem Sub MessungenErmittelnUndSaeubern() eingefügt.

Sobald ich das Makro ausführen möchte passiert allerdings nichts?! Irgendwas habe ich bestimmt falsch gemacht...

xlph
21.09.2016, 17:06
Viel falsch machen kann man da eigentlich nicht.:eek: