Live-Forum - Die aktuellen Beiträge
Datum
Titel
24.04.2024 17:19:09
Formel mit Index-Funktion
24.04.2024 16:19:42
SummeWenn / SummeWenns mit Bedingung wenn kleiner als dann
24.04.2024 14:48:50
"Eingabefeld" zwischen zwei Zeilen geht nicht weg.
24.04.2024 14:40:10
Zeilenumbrüche in Textbox zählen
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1420to1424
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1420to1424
1420to1424
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Lineare Interpolation, unregelmäßige X-Abstände

Lineare Interpolation, unregelmäßige X-Abstände
11.04.2015 22:34:59
Stefano
Hallo,
ich habe eine recht simple Tabelle, in welcher ich in Spalte A Zeitpunkte in der Form hh:mm:ss vorliegen habe. In weiteren Spalten sind zu verschiedenen Zeitpunkten verschiedene Daten gemessen worden, sodass ich nun vor der Aufgabe stehe, die Lücken durch lineare Interpolation zu füllen. Problematisch ist, dass die Zeitintervalle zwischen den Messungen verschieden sind, sich also, wenn man sich das ganze graphisch vorstellt, unregelmäßige Abszissenabstände ergeben. Für Probleme mit gleichbleibenden X-Intervallen habe ich hier im Forum schon ein bisschen gesucht und bin auf diesen Beitrag gestoßen:
https://www.herber.de/forum/archiv/1388to1392/t1391260.htm
Den VBA-Code habe ich schon in meine Beispiel-Excel
( https://www.herber.de/bbs/user/97031.xlsm ) übernommen, um das Problem zu verdeutlichen (problematische Stellen habe ich exemplarisch durch gelbe und orange Füllung hervorgehoben).
Es wäre echt super, wenn mir jemand bei der Anpassung des Codes helfen, oder- falls dieser Ansatz "hoffnungslos" ist- mich auf den richtigen Weg bringen könnte.
Vielen Dank schon mal und liebe Grüße,
Stefano

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Lineare Interpolation, unregelmäßige X-Abstände
12.04.2015 11:13:20
Erich
Hi Stefano,
probier mal Option Explicit Sub machs_c() Dim rngB As Range, rngLeer As Range, rngC As Range Dim xOb As Date, xUn As Date, yOb As Double, yUn As Double, dDiff As Double On Error Resume Next Set rngB = Sheets("Tabelle1").Range("C2:C35").Cells.SpecialCells(xlCellTypeBlanks) ' Set rngB = Sheets("Tabelle1").Range("E5:E35").Cells.SpecialCells(xlCellTypeBlanks) On Error GoTo 0 If rngB Is Nothing Then Exit Sub For Each rngLeer In rngB.Areas xOb = Cells(rngLeer.Row - 1, 1).Value yOb = rngLeer(1).Offset(-1).Value xUn = Cells(rngLeer.Row + rngLeer.Count, 1).Value yUn = rngLeer(rngLeer.Count).Offset(1).Value dDiff = (yUn - yOb) / (xUn - xOb) For Each rngC In rngLeer With rngC .Value = yUn + (Cells(rngC.Row, 1) - xUn) * dDiff End With Next Next End Sub Klappt es damit?
Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich und: Schönen Restsonntag noch!

Anzeige
Lineare Interpolation - noch eine Variante
12.04.2015 11:59:21
Erich
Hi Stefano,
das ginge auch: 

Sub oderSo()
Dim rngB As Range, rngLeer As Range, arrA, zz As Long
Dim xOb As Date, xUn As Date, yOb As Double, yUn As Double, dDiff As Double
On Error Resume Next
'  Set rngB = Sheets("Tabelle1").Range("C2:C35").Cells.SpecialCells(xlCellTypeBlanks)
Set rngB = Sheets("Tabelle1").Range("E5:E35").Cells.SpecialCells(xlCellTypeBlanks)
On Error GoTo 0
If rngB Is Nothing Then Exit Sub
For Each rngLeer In rngB.Areas
xOb = Cells(rngLeer.Row - 1, 1).Value
yOb = rngLeer(1).Offset(-1).Value
xUn = Cells(rngLeer.Row + rngLeer.Count, 1).Value
yUn = rngLeer(rngLeer.Count).Offset(1).Value
dDiff = (yUn - yOb) / (xUn - xOb)
arrA = rngLeer.Offset(, 1 - rngLeer.Column).Value
' oder
' arrA = Cells(rngLeer.Row, 1).Resize(rngLeer.Count).Value
ReDim arE(1 To UBound(arrA))
For zz = 1 To UBound(arrA)
arE(zz) = yUn + (arrA(zz, 1) - xUn) * dDiff
Next zz
rngLeer = Application.Transpose(arE)
Next
End Sub
Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich

Anzeige
AW: Lineare Interpolation - noch eine Variante
12.04.2015 12:11:54
Stefano
Hallo Erich,
vielen Dank erstmal für deine Hilfe.
Leider löst der von dir angegebene Code das Problem der variablen Intervallgröße nicht, so wird beispielsweise, wenn zwischen den Zeiten 14:00:00 mit dem dazugehörigen Wert 0,18 und 14:30:00 mit dem Wert 0,144 für die Zeiten 14:00:01, 14:15:00 und 14;15:01 interpoliert werden soll, die Differenz in gleichmäßigen Schritten auf die 3 zu füllenden Zellen verteilt.
Der Code von Christian scheint dieses Problem gut zu lösen.
Grüße nach Kamp-Lintfort und auch dir einen schönen Sonntag!

mmmH...
12.04.2015 16:20:32
Erich
Hi Stegano,
da ist wohl etwas nicht richtig gelaufen. Christians Code TestIt liefert dieselben Ergebnisse wie meine Codes
(hier: oderSo):
 ABCDEFGH
813:45:001515 oderSoTestIty-Diffx-Diff
914:00:0014140,180,180,18  
1014:00:011515 0,179980,179980,0000200000:00:01
1114:15:001414 0,1620,1620,0179800000:14:59
1214:15:011515 0,161980,161980,0000200000:00:01
1314:30:0012120,1440,1440,1440,0179800000:14:59

Formeln der Tabelle
ZelleFormel
G10=L9-L10
H10=A10-A9


Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4.8
Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich

Anzeige
AW: mmmH...
12.04.2015 17:10:47
Stefano
Hi Erich,
habs nochmal getestet und siehe da- es funktioniert tatsächlich und zwar sehr gut!
Weshalb es vorhin nicht funktioniert hat, ist mir nun ein Rätsel, da ich wie zuvor nichts weiter gemacht habe, als den Namen des Tabellenblattes und die Ranges anzupassen.
Der Code ist nun sogar etwas "schöner" als der von Christian, welchen ich nun verwendet habe, weil er ohne zusätzliche Spalte für die Ergebnisse auskommt, also quasi direkt in der Spalte interpoliert wird.
Danke nochmal für die Hilfe!

AW: Lineare Interpolation, unregelmäßige X-Abstände
12.04.2015 11:14:42
Christian
hallo Stefano,
ein Bsp:
Option Explicit
Sub TestIt()
Dim i As Long, j As Long, k As Long
Dim dblX1 As Double, dblX2 As Double
Dim dblY1 As Double, dblY2 As Double
Dim dblX As Double, dblY As Double
Const lngCOLX As Long = 1       ' Spalte der Zeit-Achse
Const lngCOLY As Long = 4       ' Spalte mit Werten der Y-Achse
Const lngCOLRES As Long = 6     ' Ergebnisspalte
With ThisWorkbook.Sheets("Tabelle1")
.Columns(lngCOLRES).ClearContents
For i = 2 To .Cells(.Rows.Count, lngCOLY).End(xlUp).Row
If .Cells(i, lngCOLY)  "" Then
dblX1 = .Cells(i, lngCOLX)
dblY1 = .Cells(i, lngCOLY)
.Cells(i, lngCOLRES) = dblY1
For j = i + 1 To .Cells(.Rows.Count, lngCOLY).End(xlUp).Row
If .Cells(j, lngCOLY)  "" Then
dblX2 = .Cells(j, lngCOLX)
dblY2 = .Cells(j, lngCOLY)
For k = i + 1 To j - 1
dblX = .Cells(k, 1)
dblY = (dblY2 - dblY1) * (dblX - dblX1) / (dblX2 - dblX1) + dblY1
.Cells(k, lngCOLRES) = dblY
Next
Exit For
End If
Next
End If
Next
End With
End Sub
Bei große Datenmengen kannst du das beschleunigen, wenn du die Daten zuvor in ein Array schreibst und innerhalb des Arrays verarbeitest, anstatt jede Zelle einzeln auszulesen und zu befüllen. Das Prinzip bleibt aber das gleiche.
Gruß
Christian

Anzeige
AW: Lineare Interpolation, unregelmäßige X-Abstände
12.04.2015 12:14:28
Stefano
Hallo Christian,
vielen Dank, der Code funktioniert gut und scheint auch das zu machen, was er machen soll.
Ich wünsche dir noch einen schönen Sonntag und nochmals vielen Dank, du hast mir sehr geholfen!
Gruß,
Stefano

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige