AW: fehlende werte durch linearinterpolation
27.07.2007 07:45:00
ingUR
Hallo, Werner,
hier ein erstes Grundgerüst, das den Algorithmus für die linieare Interpolation beinhaltet.
Darüberhinaus kannst du Elemente für Deine weiteren beschriebenen Programmideen hier herausnehmen, wie z.B. das Löschen von Beriechen.
Die Veränderlichkeit in der Stundenanzahl wird in der FOR-Schleife bereits berücksichtigt, da die maximale volle Stunde in Abhängigkeit vom Zeitpunkt der letzten Messaufzeichnung inder Spalte A ermittelt wird.
Option Explicit
Sub StundenWerte()
Dim maxR As Long, r As Long
Dim h As Integer, h0 As Double, h1 As Double
Dim dh As Double, dt As Double
Dim dv As Double, v0 As Double, v1 As Double, vt As Double
' | Um ggf. zeitverzögernde Einflüsse auszuschalten,
' | kann hier während der Berechnung
' | - auf die automatische Neiuberechnung der Tabellenblätter und
' | - auf die Aktualisierung der Tabellenblattansicht
' | verzichtet werden
' | (Achtung: das gilt nicht immer!)
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
' | Ermiittling der letzten beschriebenen Datenzelle in der Spalte 1
maxR = Cells(Rows.Count, 1).End(xlUp).Row
' | Löschen aller inhalte in den Spalten G und H
Columns("G:H").ClearContents
' | Schreiben der Texte in die Spaltenkopfzeilen
Cells(1, "G") = "Zeit": Cells(1, "H") = "Zeit"
Cells(1, "G") = "h": Cells(2, "H") = "h"
Cells(1, "H") = "Zeit": Cells(1, "H") = "messwert"
Cells(1, "H") = "h": Cells(2, "H") = "mg/dl"
' | Zentrieren des Zelleninhalts im Bereich G1:H2
Range("G1:H2").HorizontalAlignment = xlCenter
' | Füllen der Zeile für die erste Meßwertaufzeichnung zum Startzeitpunkt 0
Cells(3, "G") = 0
Cells(3, "H") = Cells(3, "B")
' | Schleife über alle vollen Stunden
' | mit CInt(zahl) wird die Zahl zur nächsten Ganzzahl gerundet;
' | um also das Aufrunden zu sichern, wird hier 0.5 zum Wert addiert
For h = 1 To CInt(Cells(maxR, 1) + 0.5)
' | Schreibe Stundenzahl in die Spalte G und dort in die Zeile 3+h
' | die Zalh 3 berücksichtigt hier, dass die dritte Zeile die erste Datenzeile ist
Cells(3 + h, "G") = h
' | Es wird nun die Zellenfunktion =VERGLEICH, also als englischer Ausdruck MATCH, _
genutzt,
' | um die Zeilenmummer in der Spalte A (Culumns(1) zu ermitteln, in der der größte _
Wert steht, der
' | kleiner als der Suchwert h ist.
r = Application.WorksheetFunction.Match(h, Columns(1))
' | ist die Zeile gefunden, dann ist dies die Zeile für den Datenpunkkt P0 = {h0;v0}
' | es wirden hier die Einzelvariablien gesetzt, um den Rechengang leichter _
nachvollziehen zu können
' | (die zusammenfasung der Berechung in einer Formel wäre auch möglich)
h0 = Cells(r, "A")
v0 = Cells(r, "B")
' | die Folgezeile, r+1, enthält den zweiten Datenpunkt P1 = {h1;v1},
' | der für die lineare Interpolation benötigt wird
h1 = Cells(r + 1, "A")
v1 = Cells(r + 1, "B")
' | es folgt die Ermittlung der Differenzen zwischen den Punkten P0 und P1
' | sowie dier Zeitspanne von h0 bis zur vollen Stunde
dh = h1 - h0
dv = v1 - v0
dt = h - h0
' | die Berechnung des Vollenstundenwertes,
' | hier auch noch einmal in eine eigene Variable geschrieben, ...
vt = v0 + dt * dv / dh
' | ... um sie dann in die betreffende Zelle zu veröffentlichen.
Cells(3 + h, "H") = vt
Next h
' | Wiederherstellen der Modi "Automatische Tabelelnbattaktualisierung" und
' | "Automatische Neuberechnung"
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Für die Bezeichnung des Zellenobjekts ist hier teilweise die Schreibweise Cells(5,"F") verwedendet worden, die gleichwertig mit der Schreibweise Cells(5, 6) ist, da als Argument immer in der festen Reihenfolge die Zeilen- und die Spaltennummer zu übergeben ist. Ein gültiger Spaltenbuchstabe wird intern zur Nummer gewandelt.
Viel Erfolg sowie gute und schnelle fortschritte bei der Einarbeitung in VBA
Gruß,
Uwe