Bereich nach Zahl einfärben

[Peter Schuerer]

Hallo Zusammen,

XL2002.

Meine Tabelle geht von "A17:N300". In Spalte A stehen Zahlen wie z.B.:
200, 210, 220, 300 ...
Es stehen immer gleiche Zahlen untereinander und ich möchte jetzt die
Zahlen farblich trennen.
Also in "A17:A22" steht 200, Bereich "A17:N22" keine Farbe.
In "A23:A31" steht 210, Bereich "A23:N31" Füllfarbe Gelb.
In "A32:A43" steht 220, Bereich "A32:N43" keine Farbe.
In "A44:A57" steht 230, Bereich "A44:N57" Füllfarbe Gelb.

Wie kann man das per Makro lösen?

Danke und Gruß
Peter

[Claus Busch]

Hallo Peter,

Post by Peter Schuerer
Also in "A17:A22" steht 200, Bereich "A17:N22" keine Farbe.
In "A23:A31" steht 210, Bereich "A23:N31" Füllfarbe Gelb.
In "A32:A43" steht 220, Bereich "A32:N43" keine Farbe.
In "A44:A57" steht 230, Bereich "A44:N57" Füllfarbe Gelb.

markiere A17:N57 => Bedingte Formatierung => Formel zur Ermittlung...
=REST($A17/10;2)=1

Mit Makro:
Sub Farbe()
Dim rngC As Range

For Each rngC In Range("A17:A57")
If rngC / 10 Mod 2 = 1 Then
rngC.Resize(, 14).Interior.Color = vbYellow
End If
Next
End Sub


Mit freundlichen Grüßen
Claus

[Claus Busch]

Hallo Peter,

Post by Claus Busch
markiere A17:N57 => Bedingte Formatierung => Formel zur Ermittlung...
=REST($A17/10;2)=1

ich persönlich würde die bedingte Formatierung vorziehen, weil sie sich
den Änderungen anpasst. Mit dem Makro musst du bei Änderungen zuerst
alles wieder "entfärben" und das Makro erneut aufrufen.


Mit freundlichen Grüßen
Claus

[Peter Schuerer]

Hallo Claus,

Post by Claus Busch
markiere A17:N57 => Bedingte Formatierung => Formel zur Ermittlung...

Post by Claus Busch
=REST($A17/10;2)=1

Funktioniert teilweise. Nach 220 kommt 300, 400 und 600. Die werden
nicht eingefärbt.

Danke und Gruß
Peter

[Claus Busch]

Hallo Peter,

Post by Peter Schuerer
Funktioniert teilweise. Nach 220 kommt 300, 400 und 600. Die werden
nicht eingefärbt.

wenn man nicht alle Möglichkeiten kennt, kommt auch mal ein Fehler vor
.-(

Probiere es so:

Sub MalenNachFarben()
Dim rngC As Range
Dim LRow As Long, myCnt1 As Long, myCnt2 As Long, i As Long

With ActiveSheet
LRow = .Cells(Rows.Count, 1).End(xlUp).Row
.Range("A17:N" & LRow).Interior.Color = xlNone
For i = 18 To LRow
If Len(.Cells(i, 1)) > 0 And .Cells(i, 1) <> .Cells(i - 1, 1)
Then
myCnt1 = Application.CountIf(.Range("A:A"), .Cells(i, 1))
.Cells(i, 1).Resize(myCnt1, 14).Interior.Color = vbYellow
myCnt2 = Application.CountIf(.Range("A:A"), .Cells(i +
myCnt1, 1))
i = i - 1 + myCnt1 + myCnt2
End If
Next
End With
End Sub


Mit freundlichen Grüßen
Claus

[Frank Willberger]

Moin, Moin!

Post by Claus Busch

Post by Peter Schuerer
Funktioniert teilweise. Nach 220 kommt 300, 400 und 600. Die werden
nicht eingefärbt.

wenn man nicht alle Möglichkeiten kennt, kommt auch mal ein Fehler vor
..-(
Sub MalenNachFarben()
Dim rngC As Range
Dim LRow As Long, myCnt1 As Long, myCnt2 As Long, i As Long
With ActiveSheet
LRow = .Cells(Rows.Count, 1).End(xlUp).Row
.Range("A17:N" & LRow).Interior.Color = xlNone
For i = 18 To LRow
If Len(.Cells(i, 1)) > 0 And .Cells(i, 1) <> .Cells(i - 1, 1)
Then
myCnt1 = Application.CountIf(.Range("A:A"), .Cells(i, 1))
.Cells(i, 1).Resize(myCnt1, 14).Interior.Color = vbYellow
myCnt2 = Application.CountIf(.Range("A:A"), .Cells(i +
myCnt1, 1))
i = i - 1 + myCnt1 + myCnt2
End If
Next
End With
End Sub

habe noch eine Lösung mit eine Hilfsspalte und entsprechender bedingter
Formatierung:

Wenn Deine Werte in Spalte A17 starten, so wäre
B17 =WAHR
B18 =WENN(A18=A17;B17;NICHT(B17))
usw.

In der Spalte B wechseln sich dann bei jedem Wechsel wahr und falsch ab.
Damit lässt sich wunderbar eine alternierende Formatvorlage zuweisen.


Frank

[Peter Schuerer]

Hallo Frank,

Post by Frank Willberger
habe noch eine Lösung mit eine Hilfsspalte und entsprechender bedingter

Da meine Tabelle dynamisch gefüllt wird, ist für mich die Lösung von
Claus passender.

Danke und Gruß
Peter

[Peter Schuerer]

Hallo Claus,

Post by Claus Busch

Post by Peter Schuerer
Funktioniert teilweise. Nach 220 kommt 300, 400 und 600. Die werden

Post by Peter Schuerer
nicht eingefärbt.

wenn man nicht alle Möglichkeiten kennt, kommt auch mal ein Fehler vor
.-(

Jetzt funktioniert es wunderbar.

Danke und Gruß
Peter

[Peter Schuerer]

Hallo Claus,

Post by Claus Busch
.Range("A17:N" & LRow).Interior.Color = xlNone

Ich habe XL2002 und habe die obige Zeile geändert da "xlNone" alles mit
türkis einfärbt:
.Range("A17:N" & LRow).Interior.ColorIndex = xlNone

Danach wird "keine Farbe" eingestellt.

Gruß
Peter

[Claus Busch]

Hallo Peter,

Post by Peter Schuerer
Ich habe XL2002 und habe die obige Zeile geändert da "xlNone" alles mit
.Range("A17:N" & LRow).Interior.ColorIndex = xlNone

gut, dass du das selbst herausgefunden hast. Ich habe keine Möglichkeit
in 2002 zu testen.


Mit freundlichen Grüßen
Claus

[Peter Schuerer]

Hallo Claus,

Post by Claus Busch
gut, dass du das selbst herausgefunden hast. Ich habe keine Möglichkeit
in 2002 zu testen.

Leider macht dein Makro jetzt nicht mehr das was es soll.
Darf ich dir mal eine "Beispiel-Datei" schicken?

Danke und Gruß
Peter

[Claus Busch]

Hallo Peter,

Post by Peter Schuerer
Leider macht dein Makro jetzt nicht mehr das was es soll.
Darf ich dir mal eine "Beispiel-Datei" schicken?

hast du meine Adresse noch?


Mit freundlichen Grüßen
Claus