Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
820to824
820to824
Aktuelles Verzeichnis
Verzeichnis Übersicht
Verzeichnis Übersicht
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Interior.Color

Forumthread: Interior.Color

Interior.Color
26.11.2006 00:14:37
Thomas
Hallo,
ich erstelle mir mit einem Button eine Kopie meines Tabellenblatt "Eingabe"

Private Sub cmdKopie_Click()
Sheets("Eingabe").Copy After:=Sheets("Eingabe")
End Sub

Jetzt möchte ich diese Funktion gerne für das kopierte Tabellenblatt mit folgendem Kriterium erweitern:
Wenn es verbundene Zellen (im kopierten Tabellenblatt) von D : F gibt, die den Wert 1, 2, 3, 4 oder 5 enthalten,
soll diese Zeile von D : O eine rote Hintergrundfarbe erhalten.
Zeilen bei denen die Spalte D : F nicht verbunden ist bzw. nicht einen der oben genannten Werte enthalten,
sollen nicht formatiert werden.
Für Hilfe vielen Dank!
Gruss,
Thomas
Anzeige

16
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Interior.Color
26.11.2006 10:05:06
Coach
Hallo Thomas,
da es m.W. keine Formel, die den Bereich der verbundenen Zellen einer Zelle liefert, gibt, sonst wäre bedingte Formatierung möglich, hier eine VBA-Lösung:

Sub FormatiereBedingteVerbundeneZellen()
Dim i As Long, r As Range
'ggf. entfernen falls andere Formatierung erhalten bleiben sollen
ActiveSheet.Cells.Interior.ColorIndex = Null
For i = 1 To ActiveSheet.UsedRange.Rows.Count
If Cells(i, 4).MergeCells Then
If (Int(Cells(i, 4)) = Cells(i, 4)) And (Cells(i, 4) >= 1) And (Cells(i, 4) <= 5) Then
If Cells(i, 4).MergeArea.Cells.Count = 3 Then
If Intersect(Cells(i, 4).MergeArea, Cells(i, 4).Resize(1, 3)).Cells.Count = 3 Then
Range("D1:O1").Offset(i - 1).Interior.ColorIndex = 3
End If
End If
End If
End If
Next
End Sub

Gruß Coach
Anzeige
AW: Interior.Color
26.11.2006 15:05:27
Thomas
Hallo Coach,
vielen Dank für Deine sehr schnelle Hilfe!
Der Code funktioniert bis auf eine Kleinigkeit eigentlich auch sehr gut.
Problem:
- Wenn in der 1. Zeile vom Tabellenblatt in der Verbundzelle D:F nicht ein Wert zwischen 1 -5 sondern z. B. ein Text steht, bekomme ich den Laufzeitfehler 13, Typen unverträglich und die Funktion wird abgebrochen.
- Habe ich z. B. in den ersten beiden Zeilen in der Verbundzelle D:F einen Wert zwischen 1 - 5 stehen, in Zeile 3 in der Verbundzelle D:F einen Text und in Zeile 4 in D:F wieder einen Wert zwischen 1 - 5, bekommen nur die ersten beiden Zeilen die Hintergrundfarbe rot und ab Zeile 3 wird der Code nicht mehr ausgeführt.
Eine Frage habe ich noch zu Erweiterbarkeit dieses Codes:
Ist es möglich zu einem späteren Zeitpunkt z. B. anstatt die Werte 1 - 5 zu benutzen auf Buchstaben umzusteigen (A = 1, B = 2, C = 3, D = 4, E = 5)
Würde das mit folgender Änderung schon funktionieren?
If (Int(Cells(i, 4)) = Cells(i, 4)) And (Cells(i, 4) = "A") OR (Cells(i, 4) = "B") OR(Cells(i, 4) = "C") OR (Cells(i, 4) = "D") OR (Cells(i, 4) = "E") Then
Für Hilfe schon jetzt besten Dank!
Thomas
Anzeige
AW: Interior.Color
26.11.2006 15:15:56
Coach
Hallo Thomas,
ich hatte mangels anderweitiger Definition in Deiner Beschreibung unterstellt, dass alle Werte numerisch sind, so geht es in Mischformen:
For i = 1 To ActiveSheet.UsedRange.Rows.Count
If IsNumeric(Cells(i, 4)) Then
If Cells(i, 4).MergeCells Then
If (Int(Cells(i, 4)) = Cells(i, 4)) And (Cells(i, 4) >= 1) And (Cells(i, 4) If Cells(i, 4).MergeArea.Cells.Count = 3 Then
If Intersect(Cells(i, 4).MergeArea, Cells(i, 4).Resize(1, 3)).Cells.Count = 3 Then
Range("D1:O1").Offset(i - 1).Interior.ColorIndex = 3
End If
End If
End If
End If
End If
Next
Wenn Du nach Texten "filtern" möchtest, hast du im Prinzip Recht, nur ohne das
(Int(Cells(i, 4)) = Cells(i, 4))
in der Bedingung, weil das die Ganzzahligkeit sicherstellt.
Aus der Bedingung isnumeric(cells(i,4)) müßte dann natürlich not(isnumeric(cells(i,4))) werden.
Viele Grüße
Coach
Anzeige
AW: Interior.Color
26.11.2006 15:44:23
Thomas
Hallo Coach,
funktioniert nun super, danke!!!!
Eine Frage habe ich noch:
Kann die Funktion darauf eingeschränkt werden, dass sie nur angwendet wird in dem Bereich, den ich in der Seitenumbruchvorschau definiert habe (nicht grauer Bereich) und den Rest (grauer Bereich) einfach aus Performancegründen auslässt?
Gruss,
Thomas
Anzeige
AW: Interior.Color
26.11.2006 16:17:33
Coach
Hallo Thomas,
der Code wird jetzt nur auf den Druckbereich angewendet, sofern dieser definiert ist, sonst auf alle Zeilen.

Sub FormatiereBedingteVerbundeneZellen()
Dim i As Long, r As Range, rDB As Range
On Error Resume Next
'ggf. entfernen falls andere Formatierung erhalten bleiben sollen
ActiveSheet.Cells.Interior.ColorIndex = Null
Set rDB = Nothing
Set rDB = Range(ActiveSheet.PageSetup.PrintArea)
If (rDB Is Nothing) Then Set rDB = ActiveSheet.UsedRange
For i = rDB.Row To (rDB.Row + rDB.Rows.Count - 1)
If Cells(i, 4).MergeCells Then
If (Int(Cells(i, 4)) = Cells(i, 4)) And (Cells(i, 4) >= 1) And (Cells(i, 4) <= 5) Then
If Cells(i, 4).MergeArea.Cells.Count = 3 Then
If Intersect(Cells(i, 4).MergeArea, Cells(i, 4).Resize(1, 3)).Cells.Count = 3 Then
Range("D1:O1").Offset(i - 1).Interior.ColorIndex = 3
End If
End If
End If
End If
Next
Set rDB = Nothing
End Sub

Den Part
If (Int(Cells(i, 4)) = Cells(i, 4)) And (Cells(i, 4) >= 1) And (Cells(i, 4) kannst Du auch entsprechend dem Tip von Daniel gestalten, insbesondere, wenn es viele sind.
Viele Grüße
Coach
Anzeige
AW: Interior.Color
26.11.2006 15:54:15
Daniel
Hallo
probiers mal mit diesem Code.
Erweiterungen der Bedingung können einfach in der Entsprechendne CASE-Zeile eingefügt werden

Sub Makro1()
Dim Zelle As Range
Sheets("Eingabe").Copy After:=Sheets("Eingabe")
For Each Zelle In Range(Cells(1, 4), Cells(65000, 4).End(xlUp))
Select Case Zelle.Resize(1, 3).MergeCells
Case True
Select Case Zelle.Value
Case 1, 2, 3, 4, 5, "A", "B", "C", "D", "E"
Range(Zelle, Cells(Zelle.Row, 15)).Interior.ColorIndex = 3
Case Else
End Select
Case Else
End Select
Next
End Sub

Gruß, Daniel
Anzeige
AW: Interior.Color
26.11.2006 16:09:29
Coach
Hallo Daniel,
der Code ist gut,gerade wenn es viele verschiedene Varianten sind, berücksichtigt nur nicht, wenn D mit anderen Zellen als E:F gemerged ist.
Gruß Coach
AW: Interior.Color
26.11.2006 16:35:17
Thomas
DANKE an Euch beiden!
Klappt nun wirklich perfekt!
Gruss,
Thomas
AW: Interior.Color
26.11.2006 16:38:24
Daniel
Hallo
dann probier mal diese Bedingung
Select Case Zelle.MergeArea.Cells.Count = 3
anstelle von
select case Zelle.Resize(1, 3).MergeCells
dann sollte die Formatierung nur noch erfolgen, wenn genau D-E-F gemerged sind
Gruß, Daniel
Anzeige
AW: Interior.Color
26.11.2006 16:49:42
Coach
Hallo Daniel,
die wäre auch korrekt bei BCD & CDE und außerdem bei vertikal verknüpften Zellen.
Warum präferierst Du das Select Case gegenüber einem If Then Else End If?
Gruß Coach
AW: Interior.Color
Daniel
Hallo
ich finde es in den meisten Fällen mit "Select Case" einfach übersichtlicher als mit IF-Then, besonders, wenn es mehr als 2 alternativen gibt, oder die Bedingung wie in diesem Fall kein Mathematischer Ausdruck, sondern eine Auflistung von Element ist.
Klar, ist geschmackssache, aber ich habe auch mal irgendwo gelesen, daß "Select Case" beim Interpretieren in etwas besseren Code umgesetzt wird als If-Then.
Allerdings dürfte das aber nur nicht wahrnehmbare Bruchteile ausmachen.
Zum Thema MergedCells
dein Einwand stimmt, aber ich denke mal, daß die Fälle nicht vorkommen.
ansonsten könnte man die Bedingung nochmal etwas anpassen:
Select case Zelle.MergeAerea.Address = Zelle.Resize(1,3).address
Gruß, Daniel
Anzeige
AW: Interior.Color
26.11.2006 17:53:06
Thomas
Hallo Daniel,
warum funktioniert der Code nicht, wenn ich vorher alle Farben entferne, bevor ich die Case ausführe?

Private Sub cmdTEST_Click()
Dim Zelle As Range
Sheets("Eingabe").Copy After:=Sheets("Eingabe")
Sheets("Eingabe (2)").Range("A1:Z1800").Select
Selection.Interior.ColorIndex = xlNone
For Each Zelle In Range(Cells(1, 4), Cells(65000, 4).End(xlUp))
Select Case Zelle.Resize(1, 3).MergeCells
Case True
Select Case Zelle.Value
Case 1, 2, 3, 4, 5
Range(Zelle, Cells(Zelle.Row, 15)).Interior.ColorIndex = 3
Case Else
End Select
Case Else
End Select
Next
End Sub

Gruss,
Thomas
Anzeige
AW: Interior.Color
26.11.2006 17:58:25
Thomas
Hallo Daniel,
warum funktioniert der Code nicht, wenn ich vorher alle Farben entferne, bevor ich die Case ausführe?

Private Sub cmdTEST_Click()
Dim Zelle As Range
Sheets("Eingabe").Copy After:=Sheets("Eingabe")
Sheets("Eingabe (2)").Range("A1:Z1800").Select
Selection.Interior.ColorIndex = xlNone
For Each Zelle In Range(Cells(1, 4), Cells(65000, 4).End(xlUp))
Select Case Zelle.Resize(1, 3).MergeCells
Case True
Select Case Zelle.Value
Case 1, 2, 3, 4, 5
Range(Zelle, Cells(Zelle.Row, 15)).Interior.ColorIndex = 3
Case Else
End Select
Case Else
End Select
Next
End Sub

Gruss,
Thomas
Anzeige
AW: Interior.Color
26.11.2006 18:33:31
Daniel
Hallo
Der Code geht wahrscheinlich deshalb nicht, weil er nicht in einem Allgemeinen Modul steht, sondern im Modul des Sheets "Eingabe".
Normalerweise müssen Zellen im Code immer mit "Sheets().Range()" oder "Sheets().Cells()" angesprochen werden.
würde der Code in einem Allgemeinen Modul stehen (und davon bin ich ausgegangen), kann die Angabe von "Sheets()." für die Zellen im gerade aktiven Sheet entfallen. Da nach dem Kopieren das neue Sheet aktiv ist, wäre daher die Eingabe von "Sheets()" unnötig.
Du hast aber den Code im Modul des Sheets("Eingabe") stehen. In diesem Fall ist es so, daß die Angabe von "Sheets()" nur für Zellen entfallen kann, die auch in diesem Sheet(Eingabe") stehen. Für alle anderen Zellen muss "Sheets()." immer mit angeben werden, unabhängig davon, ob das Sheet aktiv ist oder nicht.
daher muß dein Code so aussehen:

Private Sub cmdTEST_Click()
Dim Zelle As Range
Sheets("Eingabe").Copy After:=Sheets("Eingabe")
ActiveSheet.Range("A1:Z1800").Interior.ColorIndex = xlNone
For Each Zelle In ActiveSheet.Range(.Cells(1, 4), ActiveSheet.Cells(65000, 4).End(xlUp))
Select Case Zelle.Resize(1, 3).MergeCells
Case True
Select Case Zelle.Value
Case 1, 2, 3, 4, 5
ActiveSheet.Range(Zelle, ActiveSheet.Cells(Zelle.Row, 15)).Interior.ColorIndex = 3
Case Else
End Select
Case Else
End Select
Next
End Sub

Dabei kann man sich noch Schreibarbeit sparen, wenn man die With-Klammer verwendent.
Dann wird anstelle des mit WiTH beschriebenen Objekts (in diesem Fall das Activesheet) im folgenden Code nur noch ein "." geschrieben.
Diese Mehtode verkürzt den Code, erleichtert das Korregieren und Überarbeiten und ist angeblich auch schneller

Private Sub cmdTEST_Click()
Dim Zelle As Range
Sheets("Eingabe").Copy After:=Sheets("Eingabe")
With ActiveSheet
.Range("A1:Z1800").Interior.ColorIndex = xlNone
For Each Zelle In .Range(.Cells(1, 4), .Cells(65000, 4).End(xlUp))
Select Case Zelle.Resize(1, 3).MergeCells
Case True
Select Case Zelle.Value
Case 1, 2, 3, 4, 5
.Range(Zelle, .Cells(Zelle.Row, 15)).Interior.ColorIndex = 3
Case Else
End Select
Case Else
End Select
Next
End With
End Sub

Gruß, Daniel
Anzeige
AW: Interior.Color
Daniel
Hallo
noch ne kleine Korrektur, im ersten Code Fehlt in dieser Zeile noch ein ActiveSheet.
For Each Zelle In ActiveSheet.Range(.Cells(1, 4), ActiveSheet.Cells(65000, 4).End(xlUp))
korrekt ist:
For Each Zelle In ActiveSheet.Range(Activesheet.Cells(1, 4), ActiveSheet.Cells(65000, 4).End(xlUp))
Gruß, Daniel
Anzeige
AW: Interior.Color
26.11.2006 19:27:17
Thomas
Hallo Daniel,
nochmals vielen Dank für Deine Mühen.
Funktioniert jetzt auch direkt im Sheet "Eingabe".
Gruss,
Thomas
;
Anzeige

Infobox / Tutorial

Hintergrundfarbe von Zellen in Excel mit VBA ändern

Schritt-für-Schritt-Anleitung

Um die Hintergrundfarbe von Zellen in Excel mithilfe von VBA zu ändern, folge diesen Schritten:

  1. Öffne den Visual Basic Editor:

    • Drücke ALT + F11, um den VBA-Editor zu öffnen.

  2. Erstelle ein neues Modul:

    • Klicke mit der rechten Maustaste auf VBAProject (DeinWorkbookName) und wähle Einfügen > Modul.

  3. Füge den folgenden Code ein:

Sub FormatiereBedingteVerbundeneZellen()
    Dim i As Long
    ActiveSheet.Cells.Interior.ColorIndex = xlNone  ' Entferne vorherige Farben
    For i = 1 To ActiveSheet.UsedRange.Rows.Count
        If Cells(i, 4).MergeCells Then
            If IsNumeric(Cells(i, 4)) And (Cells(i, 4) >= 1 And Cells(i, 4) <= 5) Then
                Range("D" & i & ":O" & i).Interior.ColorIndex = 3  ' Rote Hintergrundfarbe
            End If
        End If
    Next
End Sub
  1. Führe den Code aus:
    • Schließe den VBA-Editor und kehre zu Excel zurück.
    • Drücke ALT + F8, wähle FormatiereBedingteVerbundeneZellen aus und klicke auf Ausführen.

Häufige Fehler und Lösungen

  • Laufzeitfehler 13: Typen unverträglich:

    • Dieser Fehler tritt auf, wenn der Code auf nicht-numerische Werte stößt. Stelle sicher, dass die Zellen, die überprüft werden, numerische Werte enthalten. Verwende die IsNumeric-Funktion, um dies zu überprüfen.

  • Keine Farbänderung:

    • Überprüfe, ob die Zellen tatsächlich verbunden sind. Verwende Cells(i, 4).MergeCells, um sicherzustellen, dass du nur verbundene Zellen ansprichst.

Alternative Methoden

Eine alternative Möglichkeit, die Hintergrundfarbe zu ändern, ist die Verwendung der Select Case-Anweisung. Hier ist ein Beispiel:

Sub Makro1()
    Dim Zelle As Range
    Sheets("Eingabe").Copy After:=Sheets("Eingabe")
    For Each Zelle In Range(Cells(1, 4), Cells(65000, 4).End(xlUp))
        Select Case Zelle.MergeCells
            Case True
                Select Case Zelle.Value
                    Case 1, 2, 3, 4, 5
                        Range(Zelle, Cells(Zelle.Row, 15)).Interior.ColorIndex = 3
                End Select
        End Select
    Next
End Sub

Praktische Beispiele

  1. Hintergrundfarbe für Buchstaben: Wenn du die Werte 1-5 durch Buchstaben A-E ersetzen möchtest, kannst du den Code wie folgt anpassen:
If Zelle.Value = "A" Or Zelle.Value = "B" Or Zelle.Value = "C" Or Zelle.Value = "D" Or Zelle.Value = "E" Then
    Range(Zelle, Cells(Zelle.Row, 15)).Interior.ColorIndex = 3
End If
  1. Einschränkung auf einen bestimmten Bereich: Um die Funktion nur auf einen bestimmten Druckbereich anzuwenden, verwende den folgenden Code:
Set rDB = Range(ActiveSheet.PageSetup.PrintArea)
If (rDB Is Nothing) Then Set rDB = ActiveSheet.UsedRange
' ... Rest des Codes ...

Tipps für Profis

  • Verwendung von With: Um den Code übersichtlicher zu gestalten, kannst du die With-Anweisung verwenden, um die Schreibarbeit zu minimieren und die Lesbarkeit zu erhöhen:
With ActiveSheet
    .Range("A1:Z1800").Interior.ColorIndex = xlNone
    For Each Zelle In .Range(.Cells(1, 4), .Cells(65000, 4).End(xlUp))
        ' ... Rest des Codes ...
    Next
End With
  • Verwendung von Interior.Color: Du kannst die Interior.Color-Eigenschaft verwenden, um eine RGB-Farbe zu setzen:
Range(Zelle, Cells(Zelle.Row, 15)).Interior.Color = RGB(255, 0, 0)  ' Rot

FAQ: Häufige Fragen

1. Warum funktioniert mein Code nicht, wenn ich vorher die Farben entferne? Der Code muss in einem allgemeinen Modul stehen, nicht im Modul des Arbeitsblatts. Verwende ActiveSheet, um sicherzustellen, dass die Zellen korrekt angesprochen werden.

2. Wie kann ich die Hintergrundfarbe auf eine benutzerdefinierte Farbe setzen? Verwende Interior.Color anstelle von Interior.ColorIndex, um eine RGB-Farbe zu definieren. Beispiel: .Interior.Color = RGB(255, 0, 0) für Rot.

Beliebteste Forumthreads (12 Monate)

Jetzt das Excel-Portal bewerten: Deine Stimme zählt!
Anzeige
Anzeige
Anzeige