Bereiche finden und markieren

Guten Morgen zusammen,
ich benötige einmal Hilfe für ein Makro. Das Makro soll in der Spalte A einen definierten Bereich finden. Der
Bereich geht immer vom ersten BAB bis zum letzten Z. Die Anzahl von BAB und Z kann immer unterschiedlich
sein. Wurde ein Bereich ermittelt, soll das Makro diesen Bereich in einer Farbe in der Spalte D kennzeichnen.
Die Auswahl der Farbe ist erstmal egal. Wichtig ist, dass die jeweiligen Bereiche eine andere Farbe haben.
SpalteA.SpalteD
BAB1....Markieren Bereich 1 Farbe Rot (Spalte D)
BAB2....Markieren Bereich 1 Farbe Rot (Spalte D)
BAB3....Markieren Bereich 1 Farbe Rot (Spalte D)
Z....Markieren Bereich 1 Farbe Rot (Spalte D)
Z....Markieren Bereich 1 Farbe Rot (Spalte D)
BAB2....Markieren Bereich 2 Farbe Grün (Spalte D)
Z....Markieren Bereich 2 Farbe Grün (Spalte D)
BAB1....Markieren Bereich 3 Farbe Blau (Spalte D)
BAB2....Markieren Bereich 3 Farbe Blau (Spalte D)
Z....Markieren Bereich 3 Farbe Blau (Spalte D)
Gruß
Christian

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

HI
muss es ein Makro sein?
du könntest auch so vorgehen.
1. schreibe in D1 den Wert 1
2. schreibe ab D2 bis zum Ende der Tabelle die Formel:


=Wenn(und(Links(A2;3)="BAB";Links(A1;3)"BAB");D1+1;D1)

das markierte dir dann jeden Breich durch eine andere Zahl (wird bei neuen BAB immer hochgezählt)
dann legst du eine Bedingte Formatierung für jede Zahl an, dh
=$D1=1: rot
=$D1=2: grün
=$D1=3: blau
usw
sollten das zuviele Farben werden und du willst mit 3 Farben auskommen die sich regelmäßig wiederholen, erweiterst du die Regelformel so:
=rest($D1;3)=0: blau
=Rest($D1;3)=1: rot
=Rest($D1;3)=2: grün
Gruß Daniel
ps für die Formelfreaks: ja man kann die Formel ab D2 auch kürzer schreiben:
=D1+(Links(A2;3)="BAB")*(Links(A1;3)"BAB")
obs auch einfacher ist als das WENN, muss jeder selbst für sich entscheiden

Sub einfaerben() Dim rngFirst As Range, rngC As Range Dim lngColor As Long Set rngFirst = Range("A2") lngColor = Range("D2").Interior.Color For Each rngC In Range(Cells(2, 1), Cells(Rows.Count, 1).End(xlUp)) If rngC = "Z" And rngC.Offset(1) "Z" Then Range(rngFirst, rngC).Interior.Color = lngColor Set rngFirst = rngC.Offset(1) lngColor = rngC.Offset(1, 3).Interior.Color End If Next rngC End Sub

Sub einfaerben() Dim rngFirst As Range, rngC As Range Set rngFirst = Range("A2") For Each rngC In Range(Cells(2, 1), Cells(Rows.Count, 1).End(xlUp)) If rngC = "Z" And rngC.Offset(1) "Z" Then Range(rngFirst, rngC).Offset(, 3).Interior.Color _ = WorksheetFunction.RandBetween(10 ^ 6, 10 ^ 9) Set rngFirst = rngC.Offset(1) End If Next rngC End Sub

Beliebteste Forumthreads (12 Monate)

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

194 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Bereiche finden und markieren

10 Beiträge zum Forumthread Beiträge zu diesem Forumthread

194 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread