Bereiche finden und markieren

Betrifft: Bereiche finden und markieren
von: xtian
Geschrieben am: 24.09.2020 09:11:54
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

Betrifft: AW: Bereiche finden und markieren
von: Daniel
Geschrieben am: 24.09.2020 09:35:47
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

Betrifft: AW: Bereiche finden und markieren
von: xtian
Geschrieben am: 24.09.2020 09:48:49
Hallo Daniel,
vielen Dank für deine Hilfe. Ich würde da ein Makro lieber vorziehen. Werde
mich aber mit deiner Idee später auch beschäftigen.
Gruß
Christian

Betrifft: AW: Bereiche finden und markieren
von: Rudi Maintaire
Geschrieben am: 24.09.2020 09:41:13
Hallo,
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
Gruß
Rudi

Betrifft: AW: Bereiche finden und markieren
von: xtian
Geschrieben am: 24.09.2020 09:51:11
Hallo Rudi,
vielen Dank für deine Hilfe. Irgendwo ist hier leider noch ein Fehler drin. Sehe
ihn aber leider nicht. Die Spalte D wird leider nicht eingefärbt.
Gruß
Christian

Betrifft: AW: Bereiche finden und markieren
von: Rudi Maintaire
Geschrieben am: 24.09.2020 10:13:50
Range(rngFirst, rngC)
.resize(,2).Interior.Color = lngColor

Betrifft: AW: Bereiche finden und markieren
von: xtian
Geschrieben am: 24.09.2020 10:17:34
Hallo Rudi,
leider noch immer keine Farbe.

Betrifft: AW: Bereiche finden und markieren
von: Rudi Maintaire
Geschrieben am: 24.09.2020 10:27:38
was ist denn in D?
Ich bin davon ausgegangen, dass jeweils beim ersten BAB D entsprechend eingefärbt ist.

Betrifft: AW: Bereiche finden und markieren
von: xtian
Geschrieben am: 24.09.2020 10:41:00
In Spalte D ist leider nichts. Der jeweilige Bereich (erster BAB bis letzter Z)
sollen dann in Spalte D eingefärbt sein.

Betrifft: neuer Versuch
von: Rudi Maintaire
Geschrieben am: 24.09.2020 11:29:37
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

Betrifft: AW: neuer Versuch
von: xtian
Geschrieben am: 24.09.2020 11:34:07
Rudi, läuft. Vielen lieben Dank.
Gruß
Christian
Beiträge aus dem Excel-Forum zum Thema "Bereiche finden und markieren"