AW: Wer Schreibt Mir Das MAKRO Zu Ende !?
29.09.2007 11:46:00
ingUR
Hallo, Leo van der Haydn,
eigentlich wäre es geschickt, wenn Du gleich bei der Zieleneinfügung für fehlende Datumszeilen in der Folge dieses Arbeit erledigen könntest:
Sub DatumInDerASpalteEinfuegen()
Dim lngRow As Long, lngLast As Long
Dim rng As Range
On Error GoTo ErrExit
GMS
lngLast = Cells(Rows.Count, 1).End(xlUp).Row
For Each rng In Range("A2:A" & lngLast)
If IsDate(rng) Then
If rng.Offset(1, 0) > rng + 1 Then
rng.Offset(1, 0).EntireRow.Insert
rng.Offset(1, 0) = rng + 1
rng.Offset(1, 0).NumberFormat = rng.NumberFormat
Range("B" & rng.Row & ":E" & rng.Row).Copy Destination:=rng.Offset(1, 1)
lngLast = lngLast + 1
End If
End If
Next
ErrExit:
GMS True
End Sub
Hier werden also bei Einfügen eines Datums, die Zelleninhalte der Spalten B bis E aus der Zeile vor der eingefügten Zeile in die leeren Zellen der eingefügten Zeile kopiert.
Soll tatsächlich nur der Zelleninhalt der Spalte E in die eingefügte Zeile zu übernehmen sein, dann kann auch geschrieben werden:
rng.offset(1,4)=rng.offset(0,4)
statt des Range.Copy-Befehls.
Liegen die Datumseinträge bereits in ununterbrochener Reihenfolge vor, dann muß Du in einer eigenen Prozedur das nachrägliche Auffüllen erledigen lassen:
Sub QuotesOHLC_InLeerZellenKopieren()
Dim lngRow As Long, lngLast As Long
Dim rng As Range
lngLast = Cells(Rows.Count, 1).End(xlUp).Row
For Each rng In Range("A2:A" & lngLast)
If len(rng.offset(1,4))=0 Then
Range("B" & rng.Row & ":E" & rng.Row).Copy Destination:=rng.Offset(0, 1)
End If
End If
Next
End Sub
Wieder wird hier der Bereich B:E, also O, H, L und C einer der Vorzeile in den leeren Zeilenbereich der Zeile kopiert. Das gleiche, wenn nur die Spalte E einzubeziehen ist:
Sub QuotesC_InLeerZellenKopieren()
Dim lngRow As Long, lngLast As Long
Dim rng As Range
lngLast = Cells(Rows.Count, 1).End(xlUp).Row
For Each rng In Range("E2:E" & lngLast)
If len(rng)=0 Then
rng=rng.offset(-1,0)
End If
Next
End Sub
Obwohl der Programmcode nicht geprüft ist, so meine ich, ist mit diesem Grundprinzip die Aufgabe zu lösen.
Viel Erfolg!
UWe