Microsoft Excel

Herbers Excel/VBA-Archiv

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"