Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1276to1280
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
Inhaltsverzeichnis

Zeilen vergleichen und Zeile einfügen

Zeilen vergleichen und Zeile einfügen
Marco
Hallo zusammen,
habe vor einiger Zeit mit VBA gearbeitet und bin jetzt dabei mich wieder einzufinden. Ich habe schon viel über Zeilen vergleichen und einfügen in eurem Forum gelesen. So richtig hat mich das aber noch nicht weitergebracht. Hoffe nun das ihr mir weiterhelfen könnt. Aber nun zum eigentlichen Problem:
Ich habe Messwerte einer Woche die ich in Excel importiere. Die Messwerte wurden in einem Abstand von 0,5 min (also 30s) erfasst und sind auch nach dieser Zeitachse geordnet. Das Problem besteht darin, dass die Messung (bezogen auf eine Woche) nicht durchgängig erfolgt. Das heißt sie endet beispielsweise am 18.10.2011 12:38:00 und startet wieder am 18.10.2011 13:11:30.
18.10.2011 12:37:00
18.10.2011 12:37:30
18.10.2011 12:38:00
...
18.10.2011 13:11:30
18.10.2011 13:12:00
usw.
Ich möchte nun einen Code schreiben, der die Datensätze (Zeilen) durchläuft und die aktuelle Zeit mit der darauffolgenden Zeit vergleicht ob diese eine Differenz von 30s haben. Falls dies nicht der Fall ist soll eine Zeile zwischen den beiden Datensätzen eingefügt werden. In dieser Zeile soll dann die aktuelle Zeit + 30s errechnet werden. Ziel ist also die Fehlzeiten aufzufüllen um ein lückenloses Diagramm über eine Woche darstellen zu können.
Ich habe mich darin wie folgt versucht. Für eine einzelne Zeile klappt das auch ganz gut mit
folgendem Code:

Public Sub ZeileEinfuegen()
If Cells(9, 1).Value - Cells(8, 1).Value > 0.00035 Then
Range("B9").EntireRow.Insert
Cells(9, 1).Value = Cells(8, 1) + 0.00035
End If

Allerdings möchte ich diese If-Anweisung in eine Schleife legen und habe folgendes versucht: pre>
Private Sub cmd_Zeitachse_Click()
MsgBox ("leereTabelle")
Dim y As Integer
Dim ymax As Integer
Dim neueZeile As Integer
ymax = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
For y = 2 To ymax + 1
If Cells(y + 1, 1).Value - Cells(y, 1).Value > 0.00035 Then
'If AchtiveCell.Value + 1 - AchtiveCell.Offset(y, 1).Value > 0.00035 Then
Range.Cells(y + 1, x).EntireRow.Insert
Cells(y2, 1).Value = Cells(y, 1) + 0.00035
End If
Next
End Sub
Ich hoffe ihr könnt mir helfen und mir sagen wo es hängt. Allerdings habe ich das Gefühl das ich komplett auf dem Holzweg bin. Ein schönes Wochenende wünsche ich und vielen Dank schon mal.
Gruß Marco

AW: Zeilen vergleichen und Zeile einfügen
24.08.2012 14:53:55
UweD
Hallo
ohne jetzt auf den Code selbst einzugehen...
Versuch das ganze von hinten.
Also For y = ymax + 1 to 2 Step -1
Gruß UweD

AW: Zeilen vergleichen und Zeile einfügen
24.08.2012 15:24:28
Marco
Vielen Dank für die schnelle Antwort und den Tipp.
Das heißt die Schleife einfach rückwärts laufen lassen. Aber ist das überhaupt notwendig!? Es erscheint mir eher als hätte der Compiler ein Problem mit dem Befehl
Range.Cells(y + 1, x).EntireRow.Insert
Es wird zumindest immer Range bemängelt wenn ich den Code ausführen möchte.
Gruß Marco

AW: Zeilen vergleichen und Zeile einfügen
24.08.2012 15:51:01
UweD
Hallo nochmal
so dürfte es gehen.
Private Sub cmd_Zeitachse_Click()
MsgBox ("leereTabelle")
Dim y As Integer, TB
Dim ymax As Integer
Dim neueZeile As Integer
Set TB = ActiveSheet
ymax = TB.UsedRange.SpecialCells(xlCellTypeLastCell).Row
For y = 2 To ymax
If TB.Cells(y + 1, 1).Value - TB.Cells(y, 1).Value > 0.00035 Then
TB.Rows(y + 1).Insert
TB.Cells(y + 1, 1).Value = TB.Cells(y, 1) + 0.00035
ymax = ymax + 1
End If
Next
End Sub

schönes Wochenende
UweD

Anzeige
AW: Zeilen vergleichen und Zeile einfügen
24.08.2012 16:44:09
Marco
Super!
Vielen Dank. Es funktioniert!

AW: Zeilen vergleichen und Zeile einfügen
24.08.2012 15:56:51
Tino
Hallo,
wenn ich es richtig verstanden habe könnte es so gehen.
Die Daten werden an einer gesonderten stelle ausgegeben.
https://www.herber.de/bbs/user/81559.xls
Gruß Tino

Zusatz Differenz größer 24h ?!
24.08.2012 16:16:37
Tino
Hallo,
wenn es vorkommen kann das eine Differenz größer 24h sein kann,
müsstest Du diese Zeilen (2 mal im Code) noch so anpassen.
tmpDate =  TimeSerial(Hour(tmpDate), Minute(tmpDate), Second(tmpDate))
in
tmpDate = CLng(tmpDate) + TimeSerial(Hour(tmpDate), Minute(tmpDate), Second(tmpDate))
Gruß Tino

Anzeige
AW: Zusatz Differenz größer 24h ?!
28.08.2012 13:50:47
Marco
Hallo Tino,
vielen Dank für deine sehr ausführliche und vor allem rasche Antwort. Dein Code funktioniert wie gewünscht.
Gruß Marco

AW: Zeilen vergleichen und Zeile einfügen
24.08.2012 16:55:51
Peter
Hallo Marco,
so sollte das funktionieren:
Public Sub Komplettieren()
Dim lZeile  As Long
Application.ScreenUpdating = False
With ThisWorkbook.Worksheets("Tabelle1") ' den Tabellenblattnamen ggf. anpassen!
lZeile = 9
Do Until Trim$(.Range("A" & lZeile + 2).Value) = ""
If TimeSerial(Hour(.Range("A" & lZeile).Value), Minute(.Range("A" & lZeile).Value),  _
Second(.Range("A" & lZeile).Value) + 30)  _
TimeSerial(Hour(.Range("A" & lZeile + 1).Value), Minute(.Range("A" & lZeile + 1). _
Value), Second(.Range("A" & lZeile + 1).Value)) Then
.Rows(lZeile + 1).Insert
.Range("A" & lZeile + 1).Value = CDbl(.Range("A" & lZeile).Value) + 0.000347222
End If
lZeile = lZeile + 1
Loop
End With
Application.ScreenUpdating = True
End Sub

Gruß Peter

Anzeige
AW: Zeilen vergleichen und Zeile einfügen
28.08.2012 14:00:11
Marco
Hallo Peter,
vielen Dank für die Lösung. Sie funktioniert wie ich es mir vorgestellt habe! Echt klasse. Jetzt habe ich drei unterschiedliche Lösungen für mein Problem! Vielen Dank.
Gruß Marco

300 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige