Register einfaerben, wenn...

Hallo zusammen,
ich hätte eine Frage bezüglich dem einfaerben eines Registers per Makro.
Das Makro soll alle Worksheets eines Workbooks durchlaufen. Wenn das Makro eine Zelle findet die rot eingefaerbt ist, soll auch das zugehörige Register rot eingefaerbt werden.
Die Zellen in den Tabellenblättern werden allerdings erst durch eine bedingte Formatierung rot eingefärbt, was wahrscheinlich der Knackpunkt an dieser Aufgabe ist.
Mein VBA-Code bisher:

Sub Regcolo()
Dim last_row As Long
Dim last_column As Long
Dim i As Long
Dim j As Long
Dim anzahl_wks As Integer
Dim k As Integer
anzahl_wks = ThisWorkbook.Worksheets.Count
For k = 1 To anzahl_wks
last_row = ThisWorkbook.Worksheets(k).UsedRange.Rows.Count
last_column = ThisWorkbook.Worksheets(k).UsedRange.Columns.Count
For i = 1 To last_row
For j = 1 To last_column
If ThisWorkbook.Worksheets(k).Cells(j, i).Interior.ColorIndex = 3 Then
ThisWorkbook.Worksheets(k).Tab.ColorIndex = 3
End If
Next j
Next i
Next k
End Sub

Für eure Mühen bedanke ich mich bereits im Voraus!
Grüße MarcR

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Test() Dim wks As Worksheet Dim sp As Long For Each wks In ActiveWorkbook.Worksheets On Error Resume Next wks.ShowAllData On Error GoTo 0 wks.Tab.ColorIndex = xlColorIndexNone With wks.UsedRange For sp = 1 To .Columns.Count .AutoFilter field:=sp, Criteria1:=vbRed, Operator:=xlFilterCellColor If .Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then wks.Tab.Color = vbRed .AutoFilter Exit For End If .AutoFilter field:=sp Next .AutoFilter End With Next End Sub

Sub Regcolo() Dim last_row As Long Dim last_column As Long Dim i As Long Dim j As Long Dim anzahl_wks As Integer Dim k As Integer anzahl_wks = ThisWorkbook.Worksheets.Count For k = 1 To anzahl_wks last_row = ThisWorkbook.Worksheets(k).UsedRange.Rows.Count last_column = ThisWorkbook.Worksheets(k).UsedRange.Columns.Count MsgBox last_row MsgBox last_column For i = 1 To last_row For j = 1 To last_column If Left(ThisWorkbook.Worksheets(k).Cells(i, j).Text, 1) = " " Then ThisWorkbook.Worksheets(k).Tab.ColorIndex = 3 End If Next j Next i Next k End Sub

Sub Regcolo() Dim last_row As Long Dim last_column As Long Dim i As Long Dim j As Long Dim anzahl_wks As Integer Dim k As Integer anzahl_wks = ThisWorkbook.Worksheets.Count For k = 1 To anzahl_wks last_row = ThisWorkbook.Worksheets(k).UsedRange.Rows.Count last_column = ThisWorkbook.Worksheets(k).UsedRange.Columns.Count For i = 1 To last_row For j = 1 To last_column If Left(ThisWorkbook.Worksheets(k).Cells(i, j).Text, 1) = " " Then ThisWorkbook.Worksheets(k).Tab.ColorIndex = 3 End If Next j Next i Next k End Sub

Beliebteste Forumthreads (12 Monate)

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread