![]() |
Betrifft: Farbigen Rangebereich auswählen
von: Burghard
Hallo,
kann mir jemand helfen? Ich möchte unten den Rangebereich bis Ende der Farbe 34 auswählen.
Ich habe dazu den Aufruf im Klartext geschrieben.
Schönen Gruß
Burghard
=========================================================
Sub Auffuellen()
On Error GoTo ende
Dim letzte As Long
Dim letztezeile
letzte = Range("a65536").End(xlUp).Rows
letztezeile = ActiveSheet.Cells(65536, 1).End(xlUp).Row
Dim intI As Integer
Dim intLastRow As Integer
intLastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To intLastRow
If Range("A" & i).Value = "" Then
Range("A" & i).Value = Range("A" & i - 1).Value
End If
Next i
If Range("A" & letztezeile).Interior.ColorIndex = 34 Then
Range("A" & letztezeile) bis Ende der Farbe 34 in Spalte A.Select
End If
ende:
End Sub
![]() |
Betrifft: AW: Farbigen Rangebereich auswählen
von: Herby
Geschrieben am: 12.07.2008 08:51:26
Hallo Burghard,
meinst du so ?
Sub Auffuellen()
On Error GoTo ende
Dim i As Long
Dim letztezeile As Long
letztezeile = ActiveSheet.Cells(65536, 1).End(xlUp).Row
Dim intI As Integer
Dim intLastRow As Integer
intLastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To intLastRow
If Range("A" & i).Value = "" Then
Range("A" & i).Value = Range("A" & i - 1).Value
End If
Next i
ActiveSheet.Range(Cells(i, 1), Cells(65536, 1)).Interior.ColorIndex = 34
Exit Sub
ende:
MsgBox "Achtung! es ist ein Fehler aufgetreten "
End Sub
damit wird die komplette Spalte A beginnend mit der lezteZeile bis 65536 eingefärbt.
Viele Grüße
Herby
![]() |
Betrifft: AW: Funktioniert
von: Burghard
![]() |
Betrifft: AW: Farbigen Rangebereich auswählen
von: {Boris}
Geschrieben am: 12.07.2008 09:28:50
Hi Burghard,
da man farbige Zellen nicht mit den gängigen Excel-/VBA-Methoden finden kann, musst Du die Zellen aber der letzten Zeile nach unten hin mit einer Schleife abklappern. Wenn Der Farbblock zusammenhängend ist, dann könnte das so aussehen (ich hab Dir den Code man ein wenig von überflüssigen Zeilen befreit):
Option Explicit
Sub Auffuellen()
On Error GoTo ende
Dim x As Long, i As Long
Dim intLastRow As Long
intLastRow = Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To intLastRow
If Range("A" & i).Value = "" Then
Range("A" & i).Value = Range("A" & i - 1).Value
End If
Next i
If Cells(intLastRow, 1).Interior.ColorIndex = 34 Then
x = intLastRow
Do
x = x + 1
Loop Until Cells(x, 1).Interior.ColorIndex <> 34
Range("A" & intLastRow, "A" & x - 1).Select
End If
ende:
End Sub
Grüße Boris
![]() |
Betrifft: AW: Funktioniert wie gewünscht!
von: Burghard
![]() |