mettre certain caractère de la cellule en certaine couleur.

[nicroq]

Bonjour

et meci d avance pour votre aide, voici mon probleme:

cellule A1 = atcgatcgggta

je souhaiterai savoir si il est possible par une macro vba de mettre les "t" en rouge, les "a" en vert, les "c" en bleu et les "g" en noir? (en sachant que toutes mes cellules ne seront composées que de ces 4 lettres.)

en vous remerciant
cordialement

 

[VikLeroy]

Re : mettre certain caractère de la cellule en certaine couleur.

Salut

Alors ça, ça peut servir
Color Palette and the 56 Excel ColorIndex Colors

J'ai mis ton texte dans une cellule en 12,1 d'une feuille excel

Sub GTAC()
LongCell = Len(Cells(12, 1).Value)
Text = Cells(12, 1).Value
For I = 1 To LongCell
CharATraiter = Mid(Text, I, 1)
Select Case CharATraiter
Case "g", "G"
ActiveCell.Characters(Start:=I, Length:=1).Font.ColorIndex = 1 'noir
Case "t", "T"
ActiveCell.Characters(Start:=I, Length:=1).Font.ColorIndex = 3 'rouge
Case "a", "A"
ActiveCell.Characters(Start:=I, Length:=1).Font.ColorIndex = 4 'vert
Case "c", "C"
ActiveCell.Characters(Start:=I, Length:=1).Font.ColorIndex = 5 'bleu
End Select
Next I
End Sub

C'est cool la génétique!

 

[Efgé]

Re : mettre certain caractère de la cellule en certaine couleur.

Bonjour nicroq, Bonjour VikLeroy
@ VikLeroy : Attention , tu utilise ActiveCell sans avoir activer de cellule..., il y a un risque.

Ma proposition:

Sub Couleur()
Dim D As Object
Set D = CreateObject("scripting.dictionary")
D("T") = 3: D("A") = 5: D("C") = 10
For i = 1 To Len(Range("$A$1"))
    On Error Resume Next 'Si un caractère n'est pas dans le dictionnaire ;)
    Range("$A$1").Characters(i, 1).Font.ColorIndex = D(UCase(Range("$A$1").Characters(i, 1).Text))
    If Err Then Err.Clear
Next i
End Sub

Cordialement

 

[VikLeroy]

Re : mettre certain caractère de la cellule en certaine couleur.

Merci

C'est vrai que j'étais passé par la création automatique de macro et je n'ai pas tout adapté.

 

[nicroq]

Re : mettre certain caractère de la cellule en certaine couleur.

merci a tous mon probleme est parfaitement résolu!!!!