Erstes Wortzeichen in einer Tabelle farblich markieren

Question

Hallo,

ich habe in B3:B44 eine Textauflistung alphabetisch sortiert. Ist es möglich bei jedem neuen Anfangsbuchstaben das erste Wortzeichen farblich zu markieren? Oder wenn das erste Wortzeichen nicht geht, evtl. dann das ganze Wort?

Schwer zu verstehen, ich versuche es besser zu erklären.

In meiner Auflistung steht z.B.:

Ananas
Apfel
Bananen
Birnen

Nun möchte ich beim ersten mit A = Ananas das das A in einer bestimmten Farbe erscheint.
Dann vom ersten mit B = Bananen das B in einer Farbe.

Vielen Dank im Voraus für Eure Hilfe.

Answer 1

Hallo,
Bedingte Formatierung Formel: =UND(B3=B3;ZÄHLENWENN($B$3:B3;B3)=1)

Gruß
fedjo

Muster

Answer 2

Fedjo, danke für den Tipp.

Aber da hast Du mich wohl falsch Verstanden.
Hier noch mal mein Beispiel:

Ananas
Apfel
Bananen
Birnen


Da möchte ich, dass bei Ananas das A farblich markiert wird, bzw. das ganze Wort, wenn ein einzelnes Zeichen nicht funktioniert.
Dann soll bei Bananen das B farblich markiert werden.

Das ganze soll mir helfen die Artikel schneller zu finden. Dann kann man sofort erkennen, wo das erste Produkt mit dem Anfangsbuchstaben K zum Beispiel ist.

Answer 3

Hallo Nick,

das geht nur pr VBA.

Gruß Hajo

Answer 4

In Bearbeitungsleiste (nicht in der Zelle) den ersten Buchstaben markieren, Farbe wählen.

Answer 5

@pronto2009, wie es manuell geht ist schon klar, er sollte es aber automatisch tun.

@Hajo, dann scheint es doch mehr Aufwand zu sein als von mir Gedacht, schade.

Answer 6

hi all ^^

zwei beispiele bzw ansaetze :-)

gruss nighty

fuer einen automatismus(durch eine eingabe verursacht)

hinter der tabelle einzufuegen

Private Sub worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Dim Zsuche As Integer
Dim suche As Range
If Target.Column = 2 And Selection.Count < 2 And Target.Row > 2 And Target.Row < 45 Then
Range("B3:B44").Font.ColorIndex = 1
For Zsuche = 1 To 26
Set suche = Range("B2:B44").Find(Mid("ABCDEFGHIJKLMNOPQRSTUVWXYZ", Zsuche, 1))
If Not suche Is Nothing Then
If Mid("ABCDEFGHIJKLMNOPQRSTUVWXYZ", Zsuche, 1) = Mid(Cells(suche.Row, 2), 1, 1) Then
Cells(suche.Row, 2).Characters(Start:=1, Length:=1).Font.ColorIndex = 7
End If
End If
Next Zsuche
End If
Application.EnableEvents = True
End Sub

als normales makro

Sub Farbe()
Dim Zsuche As Integer
Dim suche As Range
Range("B3:B44").Font.ColorIndex = 1
For Zsuche = 1 To 26
Set suche = Range("B2:B44").Find(Mid("ABCDEFGHIJKLMNOPQRSTUVWXYZ", Zsuche, 1))
If Not suche Is Nothing Then
If Mid("ABCDEFGHIJKLMNOPQRSTUVWXYZ", Zsuche, 1) = Mid(Cells(suche.Row, 2), 1, 1) Then
Cells(suche.Row, 2).Characters(Start:=1, Length:=1).Font.ColorIndex = 7
End If
End If
Next Zsuche
End Sub

Answer 7

Hallo,

es geht auch onhe VBA, in Zelle A2 (gehe von Daten in Spalte A aus) mit "Bedingter Formatierung

=LINKS(A1;1)<>LINKS(A2;1)

und dann den Text oder die Zelle farbig hinterlegen

Gruß

Helmut

Answer 8

hi all ^^

korrigiert :-)

gruss nighty

Private Sub worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Dim Zsuche As Integer
Dim Zaehler As Integer
Dim suche As Range
If Target.Column = 2 And Selection.Count < 2 And Target.Row > 2 And Target.Row < 45 Then
Range("B3:B44").Font.ColorIndex = 1
Zaehler = 2
For Zsuche = 1 To 26
Do
Set suche = Range("B" & Zaehler & ":B44").Find(Mid("ABCDEFGHIJKLMNOPQRSTUVWXYZ", Zsuche, 1))
If Not suche Is Nothing Then
If Mid("ABCDEFGHIJKLMNOPQRSTUVWXYZ", Zsuche, 1) = Mid(Cells(suche.Row, 2), 1, 1) Then
Cells(suche.Row, 2).Characters(Start:=1, Length:=1).Font.ColorIndex = 7
Exit Do
End If
If Mid("ABCDEFGHIJKLMNOPQRSTUVWXYZ", Zsuche, 1) <> Mid(Cells(suche.Row, 2), 1, 1) Then Zaehler = suche.Row + 1
Else
Zaehler = 2
Exit Do
End If
Loop
Next Zsuche
End If
Application.EnableEvents = True
End Sub

Sub Farbe()
Dim Zsuche As Integer
Dim Zaehler As Integer
Dim suche As Range
Range("B3:B44").Font.ColorIndex = 1
Zaehler = 2
For Zsuche = 1 To 26
Do
Set suche = Range("B" & Zaehler & ":B44").Find(Mid("ABCDEFGHIJKLMNOPQRSTUVWXYZ", Zsuche, 1))
If Not suche Is Nothing Then
If Mid("ABCDEFGHIJKLMNOPQRSTUVWXYZ", Zsuche, 1) = Mid(Cells(suche.Row, 2), 1, 1) Then
Cells(suche.Row, 2).Characters(Start:=1, Length:=1).Font.ColorIndex = 7
Exit Do
End If
If Mid("ABCDEFGHIJKLMNOPQRSTUVWXYZ", Zsuche, 1) <> Mid(Cells(suche.Row, 2), 1, 1) Then Zaehler = suche.Row + 1
Else
Zaehler = 2
Exit Do
End If
Loop
Next Zsuche
End Sub

Answer 9

@nighty,
"fuer einen automatismus(durch eine eingabe verursacht)
hinter der tabelle einzufuegen"
Entschuldige, aber wie füge ich es hinter der Tabelle ein?

@Saarbauer, besten Dank funktioniert. Markiert zwar das Ganze Wort statt des ersten Buchstaben, aber das ist nicht weiter schlimm.

Answer 10

@ all, besten Dank an alle Helfer!!!
Habe es nun hinbekommen.
Auf Euch ist immer wieder Verlass!!!!!!!!