Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Register einfaerben, wenn...

Betrifft: Register einfaerben, wenn... von: MarcR
Geschrieben am: 05.08.2014 15:04:35

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

  

Betrifft: AW: Register einfaerben, wenn... von: Hajo_Zi
Geschrieben am: 05.08.2014 15:10:06

Hallo MArc,

das auslesen der Farbe der bedingten Formatierung ist kompliziert.
Vor Jahren hat sich Bernd mal versucht
http://hajo-excel.de/chCounter3/getfile.php?id=153

GrußformelHomepage


  

Betrifft: Das Auslesen bed. Formatierung via VBA... von: EtoPHG
Geschrieben am: 05.08.2014 15:11:49

kannst du vergessen, Marc

Wie du richtig erkannt hast, ist das der Knackpunkt. Sehr aufwändig ist das machbar, aber auch dann nicht mit 100% Sicherheit vollständig.
Wenn es sich um einfache Bedingungen handelt, ist es einfacher, diese im VBA Code nochmals zu überprüfen und beim Zutreffen die Register zu färben.

Gruess Hansueli


  

Betrifft: AW: Register einfaerben, wenn... von: Daniel
Geschrieben am: 05.08.2014 15:37:27

Hi

die Einzige Methode um herauszufinden, ob eine Zelle eine bestimmte Farbe hat welche auch die Bedingte Formatierung berücksichtigt, ist der Autofilter.
Du musst also pro Tabellenblatt in einer Schleife über die Spalten laufen, diese nach "rot" filtern und schauen, ob es ausser der Überschriftenzeile noch weitere sichtbare Zeilen gibt.
Zellen, die normal rot sind, werden auch mit gezählt, das unterscheidet der Autofilter dann nicht:

das wäre der Code dazu:

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
Gruß Daniel


  

Betrifft: Das wäre dann die 4.Methode, quasi eine ... von: Luc:-?
Geschrieben am: 05.08.2014 17:09:45

…eigenständige und wie die 1.Methodengruppe (PixelLösung) auf die ZellFarbe eingeschränkte Methode in der 3.Methodengruppe (Gandalf alias Ewald), in der man Xl das Problem selbst lösen lässt.
Die meisten Lösungsversuche (auch die von Hajo verwendete Grundlage von Bernd alias bst) gehören aber zur 2.Methodengruppe zu der du in diesem Thread Darstellungen und alternativen PgmCode (von MichaV) findest. Das bezieht sich aber alles auf die alte BedingtFormatierung (vor xl12) wie auch das hier gezeigte Bsp.
Gruß, Luc :-?


  

Betrifft: AW: Das wäre dann die 4.Methode, quasi eine ... von: Ewald
Geschrieben am: 05.08.2014 19:08:07

Hallo,

das sollte kein Problem sein,

in der bed. Formatierung welche die Zelle rot färbt,gehst du in der Formatierung auf Schrift, dort gibst du vor dem eingestellten Format " " ein.

zB." "Standard für eine als Standard formatierte Zelle.

Nun kannst du mit folgendem Makro den Tab färben.

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
PS. bei deinem geposteten Code ist bei Cells i und j vertauscht.

Gruß Ewald


  

Betrifft: AW: Das wäre dann die 4.Methode, quasi eine ... von: Ewald
Geschrieben am: 05.08.2014 19:22:33

Hallo,

Nachtrag: die Msgboxen können raus,waren nur zum Test.

sollte dann so aussehen

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
damit du auch zurücksetzen kannst
Sub Rücksetzen()
Dim i As Long
For i = 1 To ThisWorkbook.Worksheets.Count
    ThisWorkbook.Worksheets(i).Tab.Color = xlNone
Next
End Sub
Gruß Ewald