Letzte Zeile anders schraffieren als vorletzte.

Question

Hallo,

ich bin dabei einen "endlos"-Besprechungsbericht in Excel zu erstellen. D.h. wenn eine neue Besprechung ansteht schreibe ich am Ende einfach in die nächste freie Zeile eine Besprechungsnummer+1, neues Datum usw.
Dies erledige ich mit nachfolgendem Makro:

Sub Eine_Zeile_am_Ende_einfuegen_und_BesprechungsNr_erhoehen()
'i = ActiveCell.Row
I = [A65536].End(xlUp).Row
j = 1
k = 1
Rows(I + 1 & ":" & I + 1).Select

For j = 1 To 1
Selection.Insert Shift:=xlDown
Rows(I & ":" & I).Select
Selection.Copy
Range("A" & I + 1).Select
ActiveSheet.Paste
If IsNumeric(ActiveSheet.Cells(I + 1, 2).Value) Then
ActiveSheet.Cells(I + 1, 2).Formula = ActiveSheet.Cells(I + 1, 2).Value + k
End If
ActiveSheet.Cells(I + 1, 4).Value = 1
ActiveSheet.Cells(I + 1, 5).Value = Date
ActiveSheet.Cells(I + 1, 6).Value = ""
ActiveSheet.Cells(I + 1, 7).Value = ""
ActiveSheet.Cells(I + 1, 8).Value = ""
ActiveSheet.Cells(I + 1, 9).Value = ""
ActiveSheet.Cells(I + 1, 10).Value = ""
ActiveSheet.Cells(I + 1, 11).Value = ""
ActiveSheet.Cells(I + 1, 12).Value = ""
ActiveSheet.Cells(I + 1, 13).Value = "ein"
k = k - 1
Next
End Sub

Mein Wunsch ist es jetzt, die einzelnen Besprechung voneinander durch eine wechselnde (mit und ohne) Schraffierung abzuheben. Geschafft habe ich, die vorletzte und letze Zeile zu bestimmen:

Dim loLetzte As Long
Dim loVorLetzte As Long

loLetzte = IIf(IsEmpty(Cells(Rows.Count, 1)), Cells(Rows.Count, 1).

Answer 1

es fehlt noch was ...

loLetzte = IIf(IsEmpty(Cells(Rows.Count, 1)), Cells(Rows.Count, 1).End(xlUp).Row, Rows.Count)
loVorLetzte = IIf(IsEmpty(Cells(Rows.Count, 1)), Cells(Rows.Count, 1).End(xlUp).Offset(-1).Row, Rows.Count)

Aber mit der Abfrage und Setzung nach Schraffierung ja oder nein beiße ich mir die Zähne aus !!!

Wäre sehr schön, wenn mir jemand helfen könnte ... Vielen Dank schon jetzt !!

Answer 2

Hallo Erich,

ich würde das wie folgt lösen:

'Zeile schraffieren, falls Zeilennummer gerade ist
If (I + 1) Mod 2 = 0 Then Rows(I + 1).Interior.Pattern = xlLightDown

Noch ein kurzer Hinweis zu deinem Makro: Auf Select kannst du meistens verzichten. Ich habe den Code einfach mal etwas zusammengefasst:

Sub Eine_Zeile_am_Ende_einfuegen_und_BesprechungsNr_erhoehen_neu()

Dim i, j, k As Long

i = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row 'andere Möglichkeit für letzte Zeile zu ermitteln

j = 1
k = 1

For j = 1 To 1
'Zeile 1 wird kopiert
Rows(1).Copy Rows(i + 1)

'Zeile schraffieren, falls Zeilennummer gerade ist
If (i + 1) Mod 2 = 0 Then Rows(i + 1).Interior.Pattern = xlLightDown

If IsNumeric(ActiveSheet.Cells(i + 1, 2).Value) Then
ActiveSheet.Cells(i + 1, 2).Formula = ActiveSheet.Cells(i + 1, 2).Value + k
End If

ActiveSheet.Cells(i + 1, 4).Value = 1
ActiveSheet.Cells(i + 1, 5).Value = Date
ActiveSheet.Range(Cells(i + 1, 6), Cells(i + 1, 12)).Value = ""
'oder falls Inhalt gelöscht werden soll, auch so:
'ActiveSheet.Range(Cells(i + 1, 6), Cells(i + 1, 12)).ClearContents
ActiveSheet.Cells(i + 1, 13).Value = "ein"
k = k - 1
Next
End Sub

Was du allerdings mit der IsNumeric-Abfrage willst, verstehe ich nicht.

Gruß

M.O.

Answer 3

hu all ^^

ein Beispiel ohne schleife

gruss nighty

jede zeite zeile wird im genutzten Bereich eingefaerbt
spalte IV dient als hilfsspalte

Sub Ausblenden()
Dim Lzeile As Long
Lzeile = ActiveSheet.Range(Cells(Rows.Count, 1), Cells(Rows.Count, 1)).End(xlUp).Row
Range("IV1:IV" & Lzeile).FormulaR1C1 = "=if(mod(row(),2)=1,""x"",0)"
Range("IV1:IV" & Lzeile).SpecialCells(xlCellTypeFormulas, 2).EntireRow.Hidden = True
Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Interior.ColorIndex = 3
Range("IV1:IV" & Lzeile).SpecialCells(xlCellTypeFormulas, 2).EntireRow.Hidden = False
Range("IV:IV").Delete
End Sub