Hallo,
nun sind erst einmal alle Unklarheiten beseitigt, und ich hoffe, es kommen keine
neuen hinzu. Länderspezifische Einstellungen bringen manchmal seltsame Effekte...
Das Problem mit dem Dezimalzeichen ließe sich zwar sicher lösen, aber es wäre wohl
nicht ganz angemessen, deshalb die Formatierung der vorhandenen Datenbestände zu
verändern, wenn die Sache mit den falschen Messintervallen nur relativ wenige
Daten betrifft. Übrigens ehe ich es vergesse, wenn du nicht Excel 2007 benutzt
und also nur 65536 Zeilen zur Verfügung hast, musst du deine Daten splitten, sonst
gibt es bei 30000 Datensätzen einen Fehler, wenn beim Einfügen die letzte Zeile
über den unteren Blattrand hinaus verschoben werden muss.
Da ich nicht weiß, wo das Makro steht, habe ich die Adressierung mit einem With-
Block so allgemein gehalten, dass der Code auch in jeder beliebigen anderen Datei
stehen kann, wenn die Zieldatei geöffnet ist. Das Zusammenfügen von Datum und Zeit
wird hier gleich mit erledigt, das ist sogar recht günstig, weil es uns erspart,
beim Datumswechsel ggf. die eingefügten Zeilen anpassen zu müssen. Die Spielerei
mit den Textfarben kannst du weglassen, die habe ich nur zu Testzwecken eingebaut,
um bei einem Testlauf vorhandene und neue Zeilen besser unterscheiden zu können.
Option Explicit
Sub Interpolieren()
Const lngAnz As Long = 3 ' Anzahl der einzufügenden Zeilen
Const lngStart As Long = 2 ' Startzeile
' ggf. anpassen, Spaltentitel ignorieren!
Dim lngZ As Long ' Zeilennummer
Dim i As Long ' Zähler für Einfügen
Dim d1 As Double, d2 As Double ' Differenz zwischen zwei Zellen
lngZ = lngStart
With Workbooks("Interpolieren.xls").Worksheets("Tabelle1")
' ggf. anpassen!
.UsedRange.Font.Color = vbRed
.Columns(1).ColumnWidth = .Columns(1).ColumnWidth * 2
.Columns(1).NumberFormat = "dd.mm.yy hh:mm"
Do
d1 = .Cells(lngZ + 1, 3) - .Cells(lngZ, 3)
d2 = .Cells(lngZ + 1, 4) - .Cells(lngZ, 4)
.Cells(lngZ, 1) = .Cells(lngZ, 1) + .Cells(lngZ, 2)
For i = 1 To lngAnz
.Rows(lngZ + 1).Insert xlDown
.Rows(lngZ + 1).Font.Color = vbBlue
.Cells(lngZ + 1, 1) = .Cells(lngZ, 1) + TimeSerial(0, 4 - i, 0)
.Cells(lngZ + 1, 3) = .Cells(lngZ, 3) + (4 - i) * d1 / 4
.Cells(lngZ + 1, 4) = .Cells(lngZ, 4) + (4 - i) * d2 / 4
Next i
lngZ = lngZ + 4
Loop Until lngZ = .Cells(.Rows.Count, 1).End(xlUp).Row
.Cells(lngZ, 1) = .Cells(lngZ, 1) + .Cells(lngZ, 2)
.Columns(2).Delete
End With
End Sub
Bei mir funktioniert der Code, aber auf einem fremden System gibt es manchmal
unerwartete Überraschungen. Sollte es also Probleme geben, melde dich einfach
noch einmal.
Gruß Jürgen
|