Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1612to1616
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Makro ändert gegen meinen Willen die Schriftfarbe

Makro ändert gegen meinen Willen die Schriftfarbe
17.03.2018 15:35:23
Christian
Hallo an euch alle,
vielleicht hat jemand von euch ja eine Idee und die Ahnung von Makros um bei meinem Problem zu helfen.
Ich markiere den Bereich E2:E18221, kopiere ihn und füge ihn an der selben Stelle ein.
Ziel ist es, dass unten stehendes Makro ausgeführt wird.
In diesem Bereich sind 37 Texte mit roter Schrifarbe versehen.
Das Makro scheint die Schriftfarbe aus E2 (schwarz) zu übernehmen. Ich hätte aber gerne, dass das was rot ist auch rot bleibt.
Es betrifft nur spalte E, die anderen Spalten, die in dem Makro invlviert sind, behalten ihre Schriftfarbe.
Hat da jemand eine Lösung? Vor allem ohne dass das Ausführen des Makros (derzeit 7 Minuten) sich nochmal merklich in die Länge zieht?
Viele Grüße
Christian

Private Sub Worksheet_Change(ByVal Target As Range)
Dim TC As Long
Dim c As Range
Application.ScreenUpdating = False
If Target.Columns.Count > 1 Then Exit Sub
If Target.Column = 5 Or Target.Column = 7 Then TC = Target.Column Else Exit Sub
'If Target.Count = 1 And Target  "" Then
On Error GoTo ERREXIT
Application.EnableEvents = False
Select Case TC
Case 5: For Each c In Target
If c  "" Then Call SpalteE(c)
Next
Case 7: For Each c In Target
If c  "" Then
Call SpalteG(c)
Call SpalteE(c)
End If
Next
End Select
ERREXIT:
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Sub SpalteG(ByVal Target As Range)
Dim r As Range, c As Range, z&, cc As Range, zf&
Dim gefunden As Boolean
If Target.Offset(, -6)  "" Then
z = Target.Row
gefunden = False
Set cc = Range("A1:A" & z - 1).Find(Target.Offset(, -6).Value, _
Range("A1"), xlValues, xlWhole)
If Not cc Is Nothing Then
zf = cc.Row
Do
Set cc = Range("A1:A" & z - 1).FindNext(cc)
If cc.Offset(, 6) = Target Then
Target.Offset(, -2) = cc.Offset(, 4) '& " " & (cc.Offset(, 4).Address)
gefunden = True
End If
Loop Until cc Is Nothing Or cc.Row = zf Or gefunden
End If
If Not gefunden Then Target.Offset(, -2).Value = "n.v."
End If
End Sub
Sub SpalteE(ByVal Target As Range)
Dim lngR As Long
lngR = Target.Row
Cells(lngR, 2).FormulaR1C1 = Cells(1, 2).FormulaR1C1
Cells(lngR, 3).FormulaR1C1 = Cells(1, 3).FormulaR1C1
Cells(lngR, 6).FormulaR1C1 = Cells(1, 6).FormulaR1C1
Cells(lngR, 8).FormulaR1C1 = Cells(1, 8).FormulaR1C1
Cells(lngR, 9).FormulaR1C1 = Cells(1, 9).FormulaR1C1
Cells(lngR, 10).FormulaR1C1 = Cells(1, 10).FormulaR1C1
Cells(lngR, 11).FormulaR1C1 = Cells(1, 11).FormulaR1C1
Cells(lngR, 12).FormulaR1C1 = Cells(1, 12).FormulaR1C1
Rows(lngR).Copy
Cells(lngR, 1).PasteSpecial xlPasteValues
Application.CutCopyMode = False
Target.Select
End Sub

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
keine Schriftfarbe geändert
17.03.2018 15:40:13
Hajo_Zi
in dem Code gibt es kein ".Font" also wird keine Schriftfarbe verändert.
Ist es vielleicht das falsche Makro.

Beiträge von Werner, Luc, robert, J.O.Maximo und folgende lese ich nicht.
AW: keine Schriftfarbe geändert
17.03.2018 15:48:17
Christian
Hallo Hajo,
hmmm habe grad versucht mal eine Bsp Datei zu erstellen, aber in der Bsp Datei wird die Farbe beibehalten, die eigentliche Datei ist mit 40 MB zu groß zum hochladen.
Werd ich wohl doch die bewährte Methode machen müssen, nach einer anderen Spalte die die Farbe behalten hat den Farbfilter einsetzen und händig die betroffenen Texte wieder rot färben.
Gruß
Christian
Anzeige
AW: keine Schriftfarbe geändert
17.03.2018 15:49:52
Christian
zur Info noch, markiere ich nur rote Zeilen und führe das Makro aus, bleibt die Schriftfarbe auch rot.

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige