Clever-Excel-Forum

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?

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

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

(03.08.2016, 16:07)Jockel schrieb: [ -> ]Hallo, da guckst du hier..: http://www.herber.de/excelformeln und bitte suchen .../tips.html?welcher=70

Hallo,

vielen Dank, hat wunderbar funktioniert!

mfg

Albundy

Fennek

Jockel

Albundy