Office: automatische Farbe bei bestimmten Worten

Hallo,


ich habe mir einen Kalender gemacht.
Nun möchte ich, dass bestimmmte Worte automatisch in einer Farbe dargestellt werden.
z. B. München rot, Hamburg blau.

Wie macht man das


Danke und Gruß

Josef

 

Hallo!

Das geht mit der Bedingten Formatierung.
Bis Excel2003 (dort im Menü Format) sind bis zu drei Bedingungen möglich.
Ab Excel2007 (dort im Ribbon Start) ist diese Begrenzung aufgehoben.

 

Danke für die Antwort.

ich habe Excel 2003.

Und wie bekomme ich das hin

Gruß

Josef

 

Hallo,

markiere den Bereich der überwacht werden soll - Menü Format - Bedingte Formatierung - Zellwert ist gleich ="München" - Format... und das gewünschte Format wählen.

Zweite weitere Format kannst du in der gleichen Weise hinzufügen.

Bei mehr als drei Bedingten Formatierungen musst du VBA verwenden.

 

Hallo Josef,

eine mögliche VBA-Lösung:

	A	B	C
15
16		Franz jagd im komplett verwahr[color=green]los[/color]ten Taxi
17		[color=brown]quer[/color] durch [color=red]München[/color] und [color=blue]Hamburg[/color].
18
19
20		[color=blue]Hamburg[/color]
21		[color=brown]quer[/color]
22		[color=red]München[/color]
23		[color=green]los[/color]
24

Im obigen Beispiel gibt es im Zellbereich B20:B23 eine Liste mit eingefärbten Wörtern; dieser Zellbereich muss den Namen ListeFarbWörter erhalten.
Markiert man zB. den Zellbereich B16:B17 und führt untenstehendes Makro aus, werden im Bereich der Markierung die Texte gemäß der Wortliste ListeFarbWörter eingefärbt.

Code:

Public Sub Worte_Einfärben()
  Dim Zelle As Range, FarbWorte As Range, FarbWort As Range
  Dim Wort$, Farbe&
  
  Set FarbWorte = Range("ListeFarbWörter")
  
  For Each Zelle In Selection.Cells
      For Each FarbWort In FarbWorte.Cells
        Wort$ = FarbWort.Value
        Farbe& = FarbWort.Font.Color
        Zelle_TextFärben Zelle, Wort$, Farbe&
      Next FarbWort
  Next Zelle
  
End Sub

Private Sub Zelle_TextFärben(Zelle As Range, Txt$, Farbe&)
  Dim AnfPos&, Pos&
  AnfPos& = 1
  Do
    Pos& = InStr(AnfPos&, Zelle.Value, Txt$)
    If Pos& < 1 Then Exit Do
    With Zelle.Characters(Start:=Pos&, Length:=Len(Txt$)).Font
'        .Name = "Arial"
'        .FontStyle = "Standard"
'        .Size = 11
'        .Strikethrough = False
'        .Superscript = False
'        .Subscript = False
'        .OutlineFont = False
'        .Shadow = False
'        .Underline = xlUnderlineStyleNone
         .Color = Farbe&
'        .TintAndShade = 0
'        .ThemeFont = xlThemeFontNone
    End With

    AnfPos& = Pos& + 1
  Loop
End Sub

 

Hallo Anton Exl,

auch wenn der Beitrag schon etwas älter ist vielen Dank dafür! Hat sehr gut funktioniert und mir wirklich weitergeholfen!

Eine kleine Variation bereitet mir aber grade Schwierigkeiten und ich hätte deshalb noch eine Frage:
Ist es mit dem Makro auch möglich, dass Wörter, die eine bestimmte Zeichenfolge enthalten markiert werden?

Also z.B. nicht nur Hamburg sonder auch Hamburger, Hamburgerin, Käsehamburger, ...?
Mit einem "*" als Platzhalter vor bzw. hinter dem Wort in der Tabelle "ListeFarbWörter" hat es leider nicht geklappt.

Vielen Dank und schöne Grüße
LexLLuci

 

Hallo,

Diese kleine Variation habe ich dir mit nachfolgendem Makro möglich gemacht:

Code:

Option Explicit

'Microsoft VBScript Regular Expressions 5.5 (C:\Windows\SysWOW64\vbscript.dll\3)
Private RgEx As Object

Public Sub Worte_Einfärben()
  Dim Zelle As Range, FarbWorte As Range, FarbWort As Range
  Dim Wort$, Farbe&
  
  Set RgEx = CreateObject("VBSCript.RegExp")
  Set FarbWorte = Range("ListeFarbWörter")
  
  For Each Zelle In Selection.Cells
      For Each FarbWort In FarbWorte.Cells
        Wort$ = FarbWort.Value
        Farbe& = FarbWort.Font.Color
        Zelle_WörterFärben_RegExpr Zelle, Wort$, Farbe&
      Next FarbWort
  Next Zelle
  
End Sub

Private Sub Zelle_WörterFärben_RegExpr(Zelle As Range, TxtMatch$, Farbe&)
  Dim Mtch As Object
  With RgEx                  '
    .Global = True           'alle Matches ermitteln, nicht bloß den ersten
    .Pattern = TxtMatch$     'Match-Muster
    .IgnoreCase = True       'Groß/Kleinschreibung nicht beachten
    For Each Mtch In .Execute(Zelle.Value)
      With Zelle.Characters(Start:=Mtch.FirstIndex + 1, Length:=Mtch.Length).Font
  '        .Name = "Arial"
  '        .FontStyle = "Standard"
  '        .Size = 11
  '        .Strikethrough = False
  '        .Superscript = False
  '        .Subscript = False
  '        .OutlineFont = False
  '        .Shadow = False
  '        .Underline = xlUnderlineStyleNone
           .Color = Farbe&
  '        .TintAndShade = 0
  '        .ThemeFont = xlThemeFontNone
      End With
    Next Mtch
  End With
End Sub

• Mit diesem Makro funktioniert alles so, wie du es bisher gewohnt warst:
  Gibst du im benannten Zellbereich "ListeFarbWörter" Folgendes ein:
  hamburg
  quer
  nchen
  los
  wird folgender markierter farbloser Text:
  Franz jagt im komplett verwahrlosten Taxi
  verquer durch Münchenzentrum, Münchenrand und Hamburg.
  
  eingefärbt wie folgt:
  Franz jagt im komplett verwahrlosten Taxi
  verquer durch Münchenzentrum, Münchenrand und Hamburg.
  
  
  
• Gibst du jedoch in den benannten Zellbereich "ListeFarbWörter" Folgendes ein:
  hamburg
  \w*quer\w*
  nchen\w*
  \w*los\w*
  wird folgender markierter farbloser Text:
  Franz jagt im komplett verwahrlosten Taxi
  verquer durch Münchenzentrum, Münchenrand und Hamburg.
  
  eingefärbt wie folgt:
  Franz jagt im komplett verwahrlosten Taxi
  verquer durch Münchenzentrum, Münchenrand und Hamburg.
  

 

Hallo,

erstmal vielen Dank für die schnell und punktgenaue Antwort!

Habe das alte Makro komplett durch das neue ersetzt aber leider kommt beim Durchführen immer die VBA Fehlermeldung "Objekt erforderlich". Muss ich noch irgendetwas beachten?

Danke und viele Grüße
LexL

 

Hallo,

Da du mir nicht mitgeteilt hast, wo im Makro dieser Fehler aufgetreten ist, musste ich mehrere Testvarianten im Makro ausprobieren, um die wahrscheinlichste Konstellation in deinem Makro zu ermitteln.
Vermutlich wird der Fehler

Code:

Laufzeitfehler '424'
Objekt erforderlich

in folgender Makrozeile

Code:

.Global = True

aufgetreten sein. Diese Zeile kannst du ermitteln, indem du im Fehlermeldungsdialogfenster nicht den Button 'Beenden' klickst, sondern den Button 'Debuggen'.

Wenn der Fehler tatsächlich in der Zeile '.Global = True' aufgetreten ist, dann hast du mit hoher Wahrscheinlichkeit die ersten 3 Makrozeilen

Code:

Option Explicit

'Microsoft VBScript Regular Expressions 5.5 (C:\Windows\SysWOW64\vbscript.dll\3)
Private RgEx As Object

von mir nicht mit übernommen, wobei die 2. Zeile ('Microsoft ....') nur Kommentar ist und daher unbedeutend ist.
Dabei sollte die 1. Zeile ('Option Explicit') enthalten sein und die 3. Zeile ('Private RgEx As Object') muss enthalten sein.

 

Hat funktioniert, vielen Dank - auch für den weiterführenden Hinweis mit dem Debuggen. VBA ist leider Neuland für mich, aber das nächste mal weiß ich Bescheid!

 

Hallo,
das ist ja ein genialer Code! Toll, vielen Dank!

Kann man damit auch Worte markieren, wie mit einem Leuchtstift? Was müsste am Code geändert werden? (Ehrlich gesagt, bekomme ich Worte in Textzellen nicht einmal manuell markiert?? Wie macht man das? Wobei, mich eigentlich interessieren würde, Einen Satz ab, inkl. Singnalwort bis zum nächsten Absatz (Chr(13), Character(10)) zu markieren.

Viele Grüße
Michael

 

Hallo Michael,

wenn du damit meinst, ob du den Hintergrund von Text einfärben kannst, so wird das in Excel nicht funktionieren. Man kann zwar den Text, der sich in Zellen befindet, (teilweise) einfärben (etc.), aber man kann nur die Zellinnenfarbe abändern, nicht aber die Texthintergrundfarbe.

Code:

Option Explicit

'Microsoft VBScript Regular Expressions 5.5 (C:\Windows\SysWOW64\vbscript.dll\3)
Private RgEx As Object

Public Sub Worte_Einfärben()
  Dim Zelle As Range, FarbWorte As Range, FarbWort As Range
  Dim Wort$, Farbe&
  
  Set RgEx = CreateObject("VBSCript.RegExp")
  Set FarbWorte = Range("ListeFarbWörter")
  
  For Each Zelle In Selection.Cells
      For Each FarbWort In FarbWorte.Cells
        If Len(FarbWort) Then
          Wort$ = FarbWort.Value
          Farbe& = FarbWort.Font.Color
          Zelle_WörterFärben_RegExpr Zelle, Wort$, Farbe&
        End If
      Next FarbWort
  Next Zelle
  Set RgEx = Nothing
End Sub

Private Sub Zelle_WörterFärben_RegExpr(Zelle As Range, TxtMatch$, Farbe&)
  Dim Mtch As Object
  On Error GoTo Err_WörterFärben
  With RgEx                  '
    .Global = True           'alle Matches ermitteln, nicht bloß den ersten
    .Pattern = TxtMatch$     'Match-Muster
    .IgnoreCase = True       'Groß/Kleinschreibung nicht beachten
[COLOR="#FF0000"]    .MultiLine = True        'Zeilenumbrüche beachten (CRLF|LF|CR)[/COLOR]
    For Each Mtch In .Execute(Zelle.Value)
      With Zelle.Characters(Start:=Mtch.FirstIndex + 1, Length:=Mtch.Length).Font
  '        .Name = "Arial"
  '        .FontStyle = "Standard"
  '        .Size = 11
  '        .Strikethrough = False
  '        .Superscript = False
  '        .Subscript = False
  '        .OutlineFont = False
  '        .Shadow = False
  '        .Underline = xlUnderlineStyleNone
           .Color = Farbe&
  '        .TintAndShade = 0
  '        .ThemeFont = xlThemeFontNone
      End With
    Next Mtch
  End With
  Exit Sub
Err_WörterFärben:
  MsgBox Err.Number & " (" & Err.Description & ")"
End Sub

Obiges Makro kann Text zeilenweise einfärben, falls eine bestimmte Zeichenfolge in der Zeile enthalten ist.
Sind zB. im Zellbereich "ListeFarbWörter" folgende 4 Einträge vorhanden:
^.*?\w*ü\w*.*?$
^.*?\w*los\w*.*?$
\w*quer\w*
(Mü|Ha)\w*

wird ein zuvor farbloser Text durch obiges Makro folgendermaßen eingefärbt, wobei nach "Taxi" ein Zeilenumbruch (Chr(10)=LF) enthalten ist:
Franz jagt im komplett verwahrlosten Taxi
verquer durch Münchenzentrum, Münchenrand und Hamburg.

oder auch folgender farbloser Text wird wie folgt eingefärbt:
Kann man damit auch Worte markieren, wie mit einem Leuchtstift?
Was müsste am Code geändert werden?
(Ehrlich gesagt, bekomme ich Worte in Textzellen nicht einmal manuell markiert?? Wie macht man das?
Wobei, mich eigentlich interessieren würde, Einen Satz ab, inkl. Singnalwort bis zum nächsten Absatz (Chr(13), Character(10)) zu markieren.

Verantwortlich für diese zeilenweise Färbeaktionen ist die rot eingefärbte Makrozeile. Die Eigenschaft ".MultiLine=True" überprüft, ob Zeilenumbrüche im Text vorhanden sind, und überprüft dazwischen liegende Textteile wie eigenständig zu behandelnde Texte.

 

Hallo,

der Thread ist zwar schon ziemlich alt, aber ich hoffe ich bekomme hier trotzdem den richtigen TIP.
Ich muss nur 2 bestimmte Worte farbig in bestimmten Zellen markieren. Aber unter der bedingten Formatierung schaffe ich es leider nur das wenn das "Stichwort" erscheint
die ganze Zelle farbig wird. Ich möchte aber nur das Wort farbig haben. Mit den oben gelisteten Antworten komme ich leider nicht zurecht.
Ich komme nicht weiter. Ich benutze Excel2016.


Vielen Dank für die Tips

 

Hallo,

ich habe dir in der beiliegenden Excel-Datei obiges Makro eingefügt zusammen mit dem benannten Zellbereich "ListeFarbWörter" (Tabelle1!A16:A19) und - wie ich hoffe - mit genügend Beschreibungen und Links zu weiterführender Literatur.

 

Hallo zusammen

habe mehrere der oben aufgeführten Versionen mal ausprobiert und bin mit der Version

Option Explicit

'Microsoft VBScript Regular Expressions 5.5 (C:\Windows\SysWOW64\vbscript.dll\3)
Private RgEx As Object

Public Sub Worte_Einfärben()
Dim Zelle As Range, FarbWorte As Range, FarbWort As Range
Dim Wort$, Farbe&

Set RgEx = CreateObject("VBSCript.RegExp")
Set FarbWorte = Range("ListeFarbWörter")

For Each Zelle In Selection.Cells
For Each FarbWort In FarbWorte.Cells
Wort$ = FarbWort.Value
Farbe& = FarbWort.Font.Color
Zelle_WörterFärben_RegExpr Zelle, Wort$, Farbe&
Next FarbWort
Next Zelle

End Sub

Private Sub Zelle_WörterFärben_RegExpr(Zelle As Range, TxtMatch$, Farbe&)
Dim Mtch As Object
With RgEx '
.Global = True 'alle Matches ermitteln, nicht bloß den ersten
.Pattern = TxtMatch$ 'Match-Muster
.IgnoreCase = True 'Groß/Kleinschreibung nicht beachten
For Each Mtch In .Execute(Zelle.Value)
With Zelle.Characters(Start:=Mtch.FirstIndex + 1, Length:=Mtch.Length).Font
' .Name = "Arial"
' .FontStyle = "Standard"
' .Size = 11
' .Strikethrough = False
' .Superscript = False
' .Subscript = False
' .OutlineFont = False
' .Shadow = False
' .Underline = xlUnderlineStyleNone
.Color = Farbe&
' .TintAndShade = 0
' .ThemeFont = xlThemeFontNone
End With
Next Mtch
End With
End Sub


sehr gut klar gekommen .

Kann man Dieses Sub den so umschreiben das er automatisch ausgeführt wird bei Zeilenänderung ????

Wenn mir da Jemand helfen könnte wäre das super Verstehe die Programmierung leider nicht so wirklich.

Gruß
Legolas