Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
712to716
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
712to716
712to716
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Hilfe bei Makro

Hilfe bei Makro
05.01.2006 20:22:13
Peter
Hallo,
in Spalte „B“ stehen Datumswerte. Ist kein Datum vorhanden werden leere Zellen
durch das vorherige Datum ergänzt..
In Spalte „O“ stehen Zahlenwerte. Ist in Spalte „B“ ein Datum und in Spalte „O“ der Wert =0 dann soll diese Spalte gelöscht werden.
Zur Probe hinterlege ich Zeilen die gelöscht werden sollen gelb.
Irgendwas mache ich falsch.
Wer kann helfen?
-siehe Anlage
https://www.herber.de/bbs/user/29756.xls
Im voraus schon Danke für die Mühe
Peter

Sub CheckDateAndColor()
Dim lngLastRow As Long
Dim lngRow As Long
On Error GoTo ErrExit
Application.ScreenUpdating = False
lngLastRow = Range("B65536").End(xlUp).Row
For lngRow = 5 To lngLastRow '- 1
If Not IsDate(Cells(lngRow, 2)) Then
Cells(lngRow, 2) = CDate(Cells(lngRow - 1, 2))
If IsDate(Cells(lngRow - 1, 2)) And Cells(lngRow - 1, 15).Value = 0 Then
Rows(lngRow - 1).Interior.ColorIndex = 6
End If
End If
Next
ErrExit:
Application.ScreenUpdating = True
End Sub

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Hilfe bei Makro
05.01.2006 20:36:44
Josef
Hallo Peter!
So wie du das willst, geht nur mit zwei Schleifen!
Sub CheckDateAndColor()
Dim lngLastRow As Long
Dim lngRow As Long
On Error GoTo ErrExit
Application.ScreenUpdating = False

lngLastRow = Range("B65536").End(xlUp).Row
If lngLastRow < 5 Then lngLastRow = 5

For lngRow = 5 To lngLastRow
  If Cells(lngRow, 2) = "" Then
    Cells(lngRow, 2) = CDate(Cells(lngRow - 1, 2))
  End If
Next
For lngRow = lngLastRow To 5 Step -1 'beim löschen immer von unten!
  If IsDate(Cells(lngRow, 2)) And Cells(lngRow, 15) = 0 Then
    Rows(lngRow).Interior.ColorIndex = 6 '.Delete
  End If
Next

ErrExit:
Application.ScreenUpdating = True
End Sub


'******************************
'* Gruß Sepp
'*
'* Rückmeldung wäre nett!
'******************************

Anzeige
AW: Hilfe bei Makro - Danke Sepp -
05.01.2006 20:57:45
Peter
Vielen Dank.
Funktioniert wie ich es mir vorgestellt habe.
Peter

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige