data verwerkings macro

[Simon22]

Ik ben met een vriend een verslag aan het maken en we willen een klein beetje data verwerken in excel.

We hebben twee kolommen met bij elkaar horende meetgegevens (10000 data punten)
de eerste kolom bestaat uit tijdstippen waarop metingen werden uigevoerd deze zijn willekeurig verdeeld. En in de tweede kolom staat de snelheid die op dat moment gemeten werd.

0.00011 8.6753
0.00198 6.6453
0.00519 7.4311
0.00771 7.3861
0.00906 5.7551
0.0103 5.9884
0.01164 7.3349
0.01167 7.1835
0.01205 9.3343
0.01874 9.5594
0.02015 9.1992
0.02467 9.7742
0.03229 6.281

Om een systematische fout in de apparatuur te corrigeren willen we de meeste van deze metingen weg gooien en alleen een aantal overlaten waar een zo vast mogelijk tijdsinterval tussen zit.
In de voorbeeld kolommen zou dat betekenen dat mijn tijdinterval 0.005 zou kunnen zijn
dan zou ik dus de eerste meting met een tijd na 0.000 willen hebben, de eerste meting met een tijd na 0.005, de eerste meting met tijd na 0.01 etc.
De voorbeeld kolommen zouden dan dus worden:

0.00011 8.6753
0.00519 7.4311
0.0103 5.9884
0.01874 9.5594
0.02015 9.1992
0.03229 6.281

Hoewel ik al enige tijd geprobeerd heb dit te maken loop ik jammer genoeg tegen een totaal gebrek aan kennis op.

Bij voorbaat dank voor jullie hulp
Simon Riedinger

 

[Spiderman]

Ik denk ongeveer zoiets

Sub DoIt()
    RemoveIntervalItems 0.005
End Sub
Sub RemoveIntervalItems(Interval As Double)

    Dim LastRow As Long
    Dim CurRow As Long

    Dim LastFoundIntervalValue As Double
    Dim CurValue As Double
    
    ' Zoek de laatste regel
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    
    ' Vervang alle punten (.) voor Komma's(,) omdat ik anders niet een juiste decimale krijg
    Columns("A:A").Replace What:=".", Replacement:=",", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

    LastFoundIntervalValue = Cells(1, 1).Value
    Cells(1, 3).Value = "Keep"
    For CurRow = 1 To LastRow
        CurValue = Cells(CurRow, 1).Value
        ' Kijk of de waarde van de huidige regel kleiner is dan de laatste waarde + de interval
        ' als dat zo is dan moet die regel worden bewaard en de laatste waarde opnieuw worden gezet
        If (LastFoundIntervalValue + Interval) <= CurValue Then
            LastFoundIntervalValue = Cells(CurRow, 1).Value
            Cells(CurRow, 3).Value = "Keep"
        End If
    Next
    
    ' Loop van onder naar boven en alle regels die niet de tekst 'Keep' hebben staan, moeten worden verwijderd
    ' uit de overige regels moet het woord 'keep' worden verwijderd
    For CurRow = LastRow To 1 Step -1
        If Cells(CurRow, 3).Value <> "Keep" Then
            Cells(CurRow, 3).EntireRow.Delete shift:=xlUp
        Else
            Cells(CurRow, 3).Value = ""
        End If
    Next

End Sub