Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1580to1584
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

Unterschiedliche Färbung verschiedener Textteile

Unterschiedliche Färbung verschiedener Textteile
14.09.2017 18:17:17
Anne123
Hallo,
ich bin VBA-Anfängerin und möchte gerne mittels eines Makros erreichen, dass bestimmte Textteile, die Ergebnis einer Formel sind, in verschiedenen Farben eingefärbt werden.
Wenn ein Teil des Formelergebnisses "(rot)" enthält, dann soll dieser Textteil rot gefärbt werden, und der Textteil "(blau)" blau gefärbt werden, ohne dass ich auch jedes Mal das Makro wieder starten muss.
Das Problem meines Makros ist, dass wenn ich z.B. in Zelle A1 "uuu(blau)und(rot)" als Text eingebe, dann soll ja nur "(blau)" blau geschrieben sein und "(rot)" rot gefärbt sein, stattdessen ist "uuu(blau)und" blau eingefärbt. Zweites Problem, was damit wahrscheinlich zusammenhängt, ist, dass wenn ich eine Formel (z.B. sage, dass in A2 der Text aus A1 stehen soll), dann ist die Färbung ebenfalls wieder falsch:
"uuu(blau)und(rot)" ist komplett rot, obwohl "uuu" schwarz sein soll, "(blau)" blau, "und" soll schwarz sein, und "(rot)" wieder rot.
Bisher habe ich dazu folgendes Makro geschrieben:

Sub TextPartColourMacro()
' Declarations and Initialisation
Dim Row As Integer, Col As Integer
Dim CurrentCellText As String
Col = 1
' Loop Through Rows 2 to 5
For Row = 1 To 50
' Get Text in Current Cell
CurrentCellText = ActiveSheet.Cells(Row, Col).Value
' Get the Position of the Text rot and blau
RotStartPosition = InStr(1, CurrentCellText, "(rot)")
BlauStartPosition = InStr(1, CurrentCellText, "(blau)")
' Colour the Word (rot) Red
If RotStartPosition > 0 Then
ActiveSheet.Cells(Row, Col).Characters(RotStartPosition, 5).Font.Color = RGB(255, 0, 0)
End If
' Colour the Word (blau) Blue
If BlauStartPosition > 0 Then
ActiveSheet.Cells(Row, Col).Characters(BlauStartPosition, 6).Font.Color = RGB(0, 0, 255) _
_
End If
Next Row
End Sub

Anbei die Excel-Datei.
https://www.herber.de/bbs/user/116244.xlsm
Könnt ihr mir helfen?

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

Betreff
Datum
Anwender
Anzeige
Unterschiedliche Färbung verschiedener Textteile
14.09.2017 18:19:01
Hajo_Zi
in Formeln kannst Du nichts färben.

Ich gebe keinen Dank für eine Rückmeldung, da ich durch solche Beiträge nicht meine Beitragszahl erhöhen muss.
Also ich schreibe keine Beiträge mit dem Betreff "Gerne u. Danke für die Rückmeldung. o.w.T."
Rückmeldung ist ja in der Heutigen Zeit nicht üblich und die wenigen die eine Rückmeldung geben, mögen mir das verzeihen, das kein Danke für eine Rückmeldung kommt.
AW: Unterschiedliche Färbung verschiedener Textteile
14.09.2017 18:55:56
Sepp
Hallo Anne,
wie Hajo schon schrieb, kannst du Formelergebnisse nicht einfärben, nur den ganzen Zellinhalt.
Der Code funktioniert an sich, du musst nur die Farbe vorher zurücksetzen.
' **********************************************************************
' Modul: Tabelle1 Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************

Option Explicit

Sub TextPartColourMacro()
' Declarations and Initialisation
Dim Row As Long, Col As Long
Dim RotStartPosition As Long, BlauStartPosition As Long

Col = 1

' Loop Through Rows 2 to 5
For Row = 1 To 50
  With ActiveSheet.Cells(Row, Col)
    .Characters.Font.Color = vbBlack
    RotStartPosition = InStr(1, .Value, "(rot)")
    BlauStartPosition = InStr(1, .Value, "(blau)")
    ' Colour the Word (rot) Red
    If RotStartPosition > 0 Then
      .Characters(RotStartPosition, 5).Font.Color = RGB(255, 0, 0)
    End If
    ' Colour the Word (blau) Blue
    If BlauStartPosition > 0 Then
      .Characters(BlauStartPosition, 6).Font.Color = RGB(0, 0, 255)
    End If
  End With
Next Row
End Sub

Gruß Sepp

Anzeige
Sollte zu Anne! o.T.
14.09.2017 18:56:40
Sepp
Gruß Sepp

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige