Farbteppich über nicht ausgeblendeten Bereich

Guten Tag
Mit nachfolgendem Code lege ich einen Farbteppich über die selektierten Zellen.
Nun möchte ich einen weiteres Makro, das mir im selektierten Bereich nur die eingeblendeten Zellen einfärbt.
Ich habe mir folgenden Lösungsansatz überlegt:
Zuweisung der nicht ausgeblendeten Zeilennummern des selektierten Bereichs an eine Variable
Zusätzlich die Farben 0-2-4-6 logisch in dieser Variable "verknüpfen" (die Zeilen 1-3-5 werden nicht eingefärbt)
dann die entsprechenden Zeilen, im Bereich der Selektion, einfärben.
Kann mir da jemand weiterhelfen - oder auf einen besseren Lösungsansatz hinweisen?
Danke und Gruss, Peter

Sub Farbteppich_Selection()
Dim rCell As Range, rBereich As Range
Set rBereich = Selection
For Each rCell In rBereich
Select Case rCell.Row Mod 6
Case 2:     rCell.Interior.Color = 14994616     '''' hell-blaue Füllung
Case 4:     rCell.Interior.Color = 10092543    ''' hell-gelbe Füllung
Case 0:     rCell.Interior.Color = 11851260    ''' hell-braune Füllung
Case Else:  rCell.Interior.Color = xlNone
End Select
Next
'On Error GoTo 0
End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

For Each rCell In rBereich If Not (rCell.Rows.Hidden Or rCell.Columns.Hidden) Then Select Case rCell.Row Mod 6 Case 2: rCell.Interior.Color = 14994616 '''' hell-blaue Füllung Case 4: rCell.Interior.Color = 10092543 ''' hell-gelbe Füllung Case 0: rCell.Interior.Color = 11851260 ''' hell-braune Füllung Case Else: rCell.Interior.Color = xlNone End Select End If Next

Hallo,
teste mal:

Public Sub Farbteppich_Selection()
    Dim objCell As Range, lngRow As Long, lngIndex As Long
    With Selection
        For lngRow = 1 To .Rows.Count
            If Not .Rows(lngRow).Hidden Then
                lngIndex = lngIndex + 1
                Select Case lngIndex Mod 6
                    Case 2: .Range(.Cells(lngRow, 1), .Cells(lngRow, .Columns.Count)).Interior.Color = 14994616 ''' hell-blaue Füllung
                    Case 4: .Range(.Cells(lngRow, 1), .Cells(lngRow, .Columns.Count)).Interior.Color = 10092543 ''' hell-gelbe Füllung
                    Case 0: .Range(.Cells(lngRow, 1), .Cells(lngRow, .Columns.Count)).Interior.Color = 11851260 ''' hell-braune Füllung
                    Case Else: .Range(.Cells(lngRow, 1), .Cells(lngRow, .Columns.Count)).Interior.Color = xlNone ''' keine Füllung
                End Select
            End If
        Next
    End With
End Sub

Das sollte erheblich schneller sein als dein alter Code da ich nur die Zeilen durchlaufe und nicht die Spalten. Hat aber den Nachteil dass ausgeblendete Spalten, so es sie gibt, auch eingefärbt werden.
Gruß
Nepumuk

Public Sub Farbteppich_Selection_nur_gefilterte_Zeilen() Dim objCell As Range, lngRow As Long, lngIndex As Long, lngNotHidden As Long lngNotHidden = 0 With Selection For lngRow = 1 To .Rows.Count If Not .Rows(lngRow).Hidden Then lngNotHidden = lngNotHidden + 1 lngIndex = lngIndex + 1 Select Case lngNotHidden Mod 6 Case 2: Range(.Cells(lngRow, 1), .Cells(lngRow, .Columns.Count)).Interior. _ Color = 14994616 ''' hell-blaue Füllung Case 4: Range(.Cells(lngRow, 1), .Cells(lngRow, .Columns.Count)).Interior. _ Color = 10092543 ''' hell-gelbe Füllung Case 0: Range(.Cells(lngRow, 1), .Cells(lngRow, .Columns.Count)).Interior. _ Color = 11851260 ''' hell-braune Füllung Case Else: Range(.Cells(lngRow, 1), .Cells(lngRow, .Columns.Count)). _ Interior.Color = xlNone ''' keine Füllung End Select End If Next End With End Sub

Beliebteste Forumthreads (12 Monate)

Farbteppich über nicht ausgeblendeten Bereich

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Farbteppich über nicht ausgeblendeten Bereich

10 Beiträge zum Forumthread Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread