nach naechst hoeherem und niedrigerem Wert suchen

Hallo Leute
Ich hab in Spalte A und C Zahlen, die Zeit in sekunden darstellen.
In Spalte B und D sind die dazugehoerigen Messwerte zum Zeitpunkt aus der vorigen Spalte.
Ich moechte nun ein Makro haben dass jeden Zeitwert aus Spalte A in Spalte C sucht.
Ist der Zeitwert aus Spalte A und C gleich (normalerwiese in der gleichen Reihe) sollen die dazugehoerigen Messwerte addiert werden und in Spalte E ausgegeben werden
Falls der Zeitwert in Spalte C nicht vorliegt soll nach dem naechst niedrigem und naechst hoeherem Zeitwert gesucht werden.
Die dazu gehoerigen Messwerte (spalte D) sollen gemittelt werden ((x+y)/2) und mit dem Messwert aus spalte B addiert und ebenfalls in spalte E ausgegeben werden.
Dieser Wert soll dem Zeitwert aus spalte A zugeordnet werden (gleiche Reihe!)
Ich weiss dass man mit sverweis suchen kann. ich moechte die Prozedur aber komplett in einem Makro haben.
Kann mir jemand weiterhelfen?
Eventuell soll es auch moeglich sein wenn die Zeittwerte als hh:mm:ss vorliegen.
Ist aber erst mal nicht so wichtig
Vielen Dank
gruss Thomas

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Thomas!
Probier mal.

' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub werte()
Dim rng As Range, rngF As Range
Dim dbl1 As Double, dbl2 As Double
Dim lngR As Long, lngL As Long

On Error Resume Next

With Sheets("Tabelle1") 'Tabellenname anpassen! oder With ActiveSheet

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

  If lngL < 2 Then Exit Sub

  Set rng = .Range(.Cells(2, 3), .Cells(lngL, 3))

  For lngR = 2 To lngL

    Set rngF = rng.Find(.Cells(lngR, 1), LookAt:=xlWhole)

    If Not rngF Is Nothing Then
      .Cells(lngR, 5) = rngF.Offset(0, 1) + .Cells(lngR, 2)
    Else
      dbl1 = Evaluate("INDEX(" & rng.Offset(0, 1).Address & ",MATCH(MAX(IF(" & rng.Address & _
        "<" & .Cells(lngR, 1).Address & "," & rng.Address & "))," & rng.Address & "))")
      dbl2 = Evaluate("INDEX(" & rng.Offset(0, 1).Address & ",MATCH(MIN(IF(" & rng.Address & _
        ">" & .Cells(lngR, 1).Address & "," & rng.Address & "))," & rng.Address & "))")
      .Cells(lngR, 5) = ((dbl1 + dbl2) / 2) + .Cells(lngR, 2)
    End If

  Next

End With

On Error GoTo 0

Set rng = Nothing
Set rngF = Nothing

End Sub

PS: Ich hab angenommen, daß die Daten ab Zeile 2 beginnen!

Gruß Sepp

Beliebteste Forumthreads (12 Monate)

nach naechst hoeherem und niedrigerem Wert suchen

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread