PDA

Vollständige Version anzeigen : Mehere markierte Zeilen färben


Markus125
16.07.2014, 07:01
Hallo,

ich habe ein kleines Makro geschrieben, was mir die Zellen E;F;G;M;N;O;P und S färbt.

Sub Rot()
'
' Rot Makro
'

'
Cells(ActiveCell.Row, 1).Select
ActiveCell.Offset(0, 4).Range("A1,B1,C1,I1,J1,K1,L1,O1").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
.PatternTintAndShade = 0
End With

Cells(ActiveCell.Row, 1).Select
ActiveCell.Offset(1, 4).Select


End Sub

Nun habe ich zwei Anliegen an euch.

1. Zur Zeit funktioniert das nur mit einer Zeile, auch wenn man mehrere Zeilen markiert. Ich möchte das bei mehreren markierten Zeilen, all diese Zellen in jeder markierten Zeile gefärbt werden.

2. Es gibt noch ein kleines Problem, wenn man meine Liste filtert. Und zwar springt mein Makro nach dem ausführen automatisch in die nächste Zeile. Wird aber die nächste Zeile durch meine Filterung nicht angezeigt, befindet sich die "aktive" Zelle trotzdem dort, ich sage mal im Hintergrund. Führe ich jetzt das Makro aus, färbt es mir die falschen und nicht angezeigten Zellen. Es sollte also trotz gefilterte Liste nur in die "sichtbare" nächste Zeile springen dürfen.

Ich hoffe ihr könnt mir helfen.

Vielen Dank im Voraus.

Markus

Mc Santa
16.07.2014, 07:51
Hallo,

Teil 1 könnte etwa so aussehen:
Sub Rot()

With Intersect(Selection.EntireRow, Range("E1,F1,G1,M1,N1,O1,P1,S1").EntireColumn).Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End Sub

Teil 2 überlege ich gerade noch, vielleicht geht es nur über eine Schleife...
Was steht in deinen Zellen drin? Formeln, oder Werte, oder beides?

VG

BrunMi
16.07.2014, 08:27
Hallo,

Ich häts mit einer Schleife gemacht, dann hast du Punkt 1 und Punkt 2 in einem erfüllt.

Hier mein Code:

Sub er()

Dim s As String
Dim Zeilen() As String
Dim i As Integer

s = ""
For Each r In Selection.Rows
If r.EntireRow.Hidden = False Then
s = s & IIf(s = "", "", ", ") & r.Row
End If
Next

Zeilen = Split(s, ", ")

For i = 0 To UBound(Zeilen)
Cells(CInt(Zeilen(i)), 1).Select
ActiveCell.Offset(0, 4).Range("A1,B1,C1,I1,J1,K1,L1,O1").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Next i
End Sub

Im Anhang findest du noch eine Beispieldatei.
Dort habe ich das Makro schon eingebaut.

LG
BrunMi

Markus125
16.07.2014, 10:07
Vielen Dank an euch beiden, hätte nicht gedacht, dass es so schnell funktioniert.

Markus