Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
328to332
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
328to332
328to332
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Bedingte Formatierung

Bedingte Formatierung
25.10.2003 17:07:55
Heinz
Hallo!

Ich habe folgendes Problem:

Mehrere Zeilen in einer Tabelle enthalten jeweils die gleichen Datensätze.
Beispielsweise 5 Zeilen mit Name1, dann 7 Zeilen mit Name2 usw.

Ich möchte diese Namensgruppen jeweils farblich einheitlich markieren und beim Wechsel zu einer neuen Namensgruppe einen Trennstrich ziehen.
Wer hat eine schöne Formel dafür??

Schöne Grüße
Heinz

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Bedingte Formatierung
25.10.2003 18:28:28
Josef Ehrensberger
Hallo Heinz,

kopiere dieses Makro in das Modul der Tabelle


Private Sub Worksheet_Change(ByVal Target As Range)
'bedingte formatiereung mit VBA - von Josef Ehrensberger
'Untereinander stehende Zellen mit gleichem
'Inhalt werden mit der selben Hintergrungfarbe Formatiert.
'Die einzelnen Farbblöcke werden mit einem Trennstrich versehen.
'Maximale Anzahl von unterschiedlichen einträgen ist zehn (kann erhöht werden)
'Beispiel bezieht sich auf Spalte "A"
Dim rng As Range
Dim bereich As Range
Dim loEnd As Long
Dim iCnt As Integer
Dim ColArr As Variant
If Target.Column <> 1 Then Exit Sub
Application.EnableEvents = False
Application.ScreenUpdating = False
On Error Resume Next
ColArr = Array(38, 37, 35, 40, 19, 34, 24, 22, 43, 44) 'Farben definieren bei bedarf Farben hinzufügen
loEnd = ActiveSheet.Range("A65536").End(xlUp).Row 'Spalte "A" bei bedarfe ändern
Set bereich = Range("A1:A" & loEnd) 'Bereich hier in Spalte "A" bei bederf ändern
[A:A].ClearFormats
For Each rng In bereich
If rng = rng.Offset(1, 0) Then
rng.Interior.ColorIndex = ColArr(iCnt)
rng.Borders(xlEdgeBottom).LineStyle = xlNone
Else
rng.Interior.ColorIndex = ColArr(iCnt)
rng.Borders(xlEdgeBottom).LineStyle = xlContinuous
iCnt = iCnt + 1
End If
Next
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub


Das Beispiel beziht sich auf Spalte "A"!
Es sind zehn unterschiedliche Inhalte möglich (kann erhöht werden!).

Gruß Sepp
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige