Zeilen bei Gruppenwechsel farblich markieren

[Albundy]

Hallo,

ich habe in Spalte B Anzahl x Teilenummern. Da bei kommt es vor, dass Teilenummern gleiche Teilenummern mehrfach vorhanden sein können.
 Zum Beispiel:
[
Bild bitte so als Datei hochladen: Klick mich!
]

Jetzt möchte ich immer bei einem Wechsel, das Zeilen gleicher Teilenummern als Block farblich markieren werden.

Also im Ergebnis so:
[
Bild bitte so als Datei hochladen: Klick mich!
]

Wie mache ich das?

[Fennek]

Hallo,

genau für diesen Zweck hatte ich vor einiger Zeit 2 Varianten Code geschrieben. Mal sehen, ob du die nötigen Anpassungen hinbekommt:

Code:

Option Base 1
Sub iBlock() 'mit Areas
Dim Ar()
spalte = 1
lr = Cells(Rows.Count, "A").End(xlUp).Row
ReDim Ar(lr)
For i = 2 To lr
   Z = IIf(Cells(i, "A") = Cells(i - 1, "A"), Z, Z + 1)
   Ar(i) = IIf(Z Mod 2 = 0, 1, "A")
Next i

Columns(spalte + 1).Insert
   Cells(1, spalte + 1).Resize(lr) = Application.Transpose(Ar)
'färben
S2 = Array(1, 2)
For Each s In S2
   For Each are In Columns(spalte + 1).SpecialCells(2, s).Areas
       Farbe = IIf(s = 1, vbYellow, vbRed)
       are.Resize(1, 3).Interior.Color = Farbe
   Next are
Next s
End Sub

'<<<<<<<<<<<<<<<<<<< >>>>>>>>>>>>>>>>>>>>

Sub iBlock() 'ohne Areas
spalte = 1
Columns(spalte + 1).Insert
lr = Cells(Rows.Count, "A").End(xlUp).Row

For i = 2 To lr
   Z = IIf(Cells(i, "A") = Cells(i - 1, "A"), Z, Z + 1)
   cells(i, Spalte+1) = IIf(Z Mod 2 = 0, 1, "A")
Next i

'färben

S2 = Array(1, 2)
For Each s In S2
   For Each are In Columns(spalte + 1).SpecialCells(2, s).Areas
       Farbe = IIf(s = 1, vbYellow, vbRed)
       are.Resize(1, 3).Interior.Color = Farbe
   Next are
Next s
End Sub

mfg

[Jockel]

Hallo, da guckst du hier..: http://www.herber.de/excelformeln und bitte suchen .../tips.html?welcher=70

[Albundy]

Hallo, da guckst du hier..: http://www.herber.de/excelformeln und bitte suchen .../tips.html?welcher=70

Hallo,

vielen Dank, hat wunderbar funktioniert!

mfg