Zeile einfügen Daten übernehmen

Werner · 2021-05-16T16:59:12+00:00

Hallo zusammen, wer kann mir helfen? Meine Tabelle hat Daten aus einem Protokoll das maschinell erstellt wird. Um eine genaue Auswertung der Anlage zu gewährleisten benötige ich jedoch eine Tabelle pro Tag für 24h (also 96 Zeilen) immer im Abstand von 15 Minuten. Mein Problem ist, dass die Quelltabelle Lücken (fehlende Zeilen) hat. Diese fehlenden Zeilen möchte ich per VBA einfügen und diese neue Zeile automatisch mit der fehlenden Uhrzeit und den Werten der restlichen Zeile aus der vorherigen Zeile auffüllen. s. Foto Eine Beispieltabelle habe ich beigefügt. Vielen Dank für Eure Hilfe im voraus. LG Werner

Hallo Werner,
teste mal:

Code:


[Cc]

Option Explicit

Public Sub InsertMissingRows()

  Dim lngRow As Long
  Dim dtmNextTime As Date, dtmPreviousTime As Date
  Dim avntTemp As Variant

  With Worksheets("RMB Report")

      For lngRow = .Cells(.Rows.Count, 1).End(xlUp).Row To 3 Step -1

          dtmNextTime = CDate(Split(.Cells(lngRow, 1).Value, " ")(1))
          dtmPreviousTime = CDate(Split(.Cells(lngRow - 1, 1).Value, " ")(1))

          If Round(CDbl(dtmNextTime - dtmPreviousTime), 4) > _
             Round(CDbl(TimeSerial(0, 15, 0)), 4) Then

             Call .Rows(lngRow).Insert

             avntTemp = Split(.Cells(lngRow - 1, 1).Value, " ")

             .Cells(lngRow, 1).Value = avntTemp(0) & _
             Format$(dtmPreviousTime + TimeSerial(0, 15, 0), " Hh:Nn ") & avntTemp(2)

             Call .Range(.Cells(lngRow - 1, 2), .Cells(lngRow - 1, 10)).Copy( _
             Destination:=.Cells(lngRow, 2))

             lngRow = lngRow + 1

          End If
      Next
  End With
End Sub

Gruß
Nepumuk

Hallo Werner,
teste mal:

Code:


[Cc]




	
	
	
	


Option Explicit

Public Sub InsertMissingRows()

  Dim lngRow As Long, lngStartMinute As Long, lngRuningtMinute As Long
  Dim dblQuater As Double
  Dim dtmNextTime As Date, dtmPreviousTime As Date
  Dim avntTemp As Variant

  dblQuater = Round(CDbl(TimeSerial(0, 15, 0)), 4)

  With Worksheets("RMB Report")

      lngStartMinute = Minute(CDate(Split(.Cells(2, 1).Value, " ")(1)))

      For lngRow = .Cells(.Rows.Count, 1).End(xlUp).Row To 3 Step -1

          lngRuningtMinute = Minute(CDate(Split(.Cells(lngRow, 1).Value, " ")(1)))

          If lngRuningtMinute <> lngStartMinute And lngRuningtMinute <> lngStartMinute + 15 And _
             lngRuningtMinute <> lngStartMinute + 30 And lngRuningtMinute <> lngStartMinute + 45 Then

             Call .Rows(lngRow).Delete

          End If
      Next

      For lngRow = .Cells(.Rows.Count, 1).End(xlUp).Row To 3 Step -1

          avntTemp = Split(.Cells(lngRow, 1).Value, " ")
          dtmNextTime = CDate(Left$(avntTemp(0), 10) & " " & avntTemp(1))

          avntTemp = Split(.Cells(lngRow - 1, 1).Value, " ")
          dtmPreviousTime = CDate(Left$(avntTemp(0), 10) & " " & avntTemp(1))

          If Round(CDbl(dtmNextTime - dtmPreviousTime), 4) > dblQuater Then

             Call .Rows(lngRow).Insert

             .Cells(lngRow, 1).Value = Format$(dtmPreviousTime + _
             TimeSerial(0, 15, 0), "dd.mm.yyyy, Hh:Nn ") & "Uhr"

             Call .Range(.Cells(lngRow - 1, 2), .Cells(lngRow - 1, 10)).Copy( _
             Destination:=.Cells(lngRow, 2))

             lngRow = lngRow + 2

          End If
      Next
  End With
End Sub

Gruß
Nepumuk

Zeile einfügen Daten übernehmen

Forumthread: Zeile einfügen Daten übernehmen

16
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Zeile einfügen Daten übernehmen

Forumthread: Zeile einfügen Daten übernehmen

16 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

16
Beiträge zum Forumthread

Beiträge zu diesem Forumthread