Voorwaardelijke opmaak van 1 karakter in een cel

[PIr]

Hallo allen,

een grote hobby van mij is Bridge.
Om het beidsysteem uit te werken gebruik ik Excel.
Hierin typ ik veelvuldig zaken als 2♦.
Daarna selecteer ik het ♦ symbool en maak dat oranje.
Ik heb met voorwaardelijke opmaak gestoeid maar kwam niet verder dan dat een cel waar dit symbool zich in bevind de gehele tekst oranje wordt.
Is het mogelijk om de kaartsybolen ♣ ♦ ♥ ♠ automatisch de kleur te laten aannemen die ik graag wil terwijl de tekst gewoon zwart blijft?

In afwachting van jullie reacties,
verbijf ik,
met vriendelijke groeten,
PIr

 

[Wigi]

Met voorwaardelijke opmaak ga je er niet komen. Die zet alles of niets in een bepaalde opmaak.

Ofwel doe je het verder manueel, ofwel ga je wat stoeien met VBA en de Characters collectie daar.

Wigi

 

[PIr]

Kan iemand mij helpen aan een dergelijk VBA script?

PIr

 

[Wigi]

Wat heb je zelf al gedaan? Heb je de macro recorder al gebruikt?

Welke code vindt je op internet met google zoekacties?

 

[PIr]

Hallo allen,

via de nieuwsgroepen van microsoft is dit het werkende resultaat geworden:

VBA:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim X As Long
Dim R As Range
If Target.Cells.Count > 1 Then Exit Sub
For Each R In Target
For X = 1 To Len(R.Value)
Select Case AscW(Mid(R.Value, X, 1))
Case 9824 'Spade symbol
R.Characters(X, 1).Font.ColorIndex = 23
Case 9827 'Club symbol
R.Characters(X, 1).Font.ColorIndex = 10
Case 9829 'Heart symbol
R.Characters(X, 1).Font.ColorIndex = 3
Case 9830 'Diamond symbol
R.Characters(X, 1).Font.ColorIndex = 45
Case Else 'No Trump symbol
R.Characters(X, 1).Font.ColorIndex = xlColorIndexAutomatic
End Select
If X > 1 Then
If Mid(R.Value, X - 1, 2) = "SA" Then
R.Characters(X - 1, 2).Font.ColorIndex = 7
End If
End If
Next
Next
End Sub

en als macro:

Sub ColorSuitSymbols()
Dim X As Long
Dim R As Range
Dim W As Worksheet
On Error Resume Next
For Each W In Worksheets
For Each R In W.UsedRange
For X = 1 To Len(R.Value)
Select Case AscW(Mid(R.Value, X, 1))
Case 9824
R.Characters(X, 1).Font.ColorIndex = 23
Case 9827
R.Characters(X, 1).Font.ColorIndex = 10
Case 9829
R.Characters(X, 1).Font.ColorIndex = 3
Case 9830
R.Characters(X, 1).Font.ColorIndex = 45
End Select
If X > 1 Then
If Mid(R.Value, X - 1, 2) = "SA" Then
R.Characters(X - 1, 2).Font.ColorIndex = 7
End If
End If
Next
Next
Next
End Sub

Groeten van PIr