Live-Forum - Die aktuellen Beiträge
Datum
Titel
24.04.2024 19:29:30
24.04.2024 18:49:56
24.04.2024 17:19:09
Anzeige
Archiv - Navigation
820to824
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
820to824
820to824
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

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

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
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
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
Anzeige
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
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
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

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige