Das Archiv des Excel-Forums

Farbigen Rangebereich auswählen

Bild

Betrifft: Farbigen Rangebereich auswählen
von: Burghard

Geschrieben am: 12.07.2008 08:21:19

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


Bild

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

Bild

Betrifft: AW: Funktioniert
von: Burghard

Geschrieben am: 12.07.2008 12:47:31
Hallo Herby,
vielen Dank für die Hilfe. Das Makro ist nicht ganz so, wie ich es wollte, hat mir aber trotzdem geholfen.
Die Lösung von Boris geht so, wie von mir gedacht.
Nochmals vielen Dank!
Schönen Gruß
Burghard

Bild

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

Bild

Betrifft: AW: Funktioniert wie gewünscht!
von: Burghard

Geschrieben am: 12.07.2008 12:49:02
Hallo Boris,
vielen Dank für die Hilfe. Das Makro geht so, wie von mir gedacht.
Nochmals vielen Dank auch für die "Umgestaltung"!
Schönen Gruß

 Bild