Tri par couleur VBA

[ascarter]

Bonjour à tous,
Dans une même cellule,j'ai du texte avec différentes couleurs. J'aimerais trier ce texte par couleur. Dans le fichier exemple,dans la case A2,j'ai 3 couleurs.J'aimerais que le texte en noir se copie dans la case B2,le texte en bleu se copie en C2....
Merci d'avance pour vos réponses.

 

[ascarter]

Re : Tri par couleur VBA

Personne ne peur m'aider?

 

[Matheop]

Re : Tri par couleur VBA

Salut ascarter.

Je te propose ce début de piste. A toi de voir si cela te convient.

Sub triCouleurs()

  Range("A2").Select
  For x = 1 To Len(ActiveCell.Value)
    If ActiveCell.Characters(Start:=x, Length:=1).Font.ColorIndex = xlAutomatic Then
       Range("B2").Value = Range("B2").Value + _
       ActiveCell.Characters(Start:=x, Length:=1).Caption
    End If
        
    If ActiveCell.Characters(Start:=x, Length:=1).Font.ColorIndex = 44 Then
       Range("D2").Value = Range("D2").Value + _
       ActiveCell.Characters(Start:=x, Length:=1).Caption
    End If
        
    If ActiveCell.Characters(Start:=x, Length:=1).Font.ColorIndex = 5 Then
       Range("C2").Value = Range("C2").Value + _
       ActiveCell.Characters(Start:=x, Length:=1).Caption
    End If

  Next x
    
  Range("B2").Value = Range("B2").Value & " "
  Range("C2").Value = Range("C2").Value & " "
  Range("D2").Value = Range("D2").Value & " "

End Sub

Bonne continuation.

 

[BOISGONTIER]

Re : Tri par couleur VBA

Bonjour,

Voir PJ

Function extraitCoul(c, noCoul)
   Application.Volatile
   For i = 1 To Len(c)
       If c.Characters(Start:=i, Length:=1).Font.ColorIndex = noCoul Then
         temp = temp & Mid(c, i, 1)
       End If
    Next i
    extraitCoul = temp
End Function

JB

 

[ascarter]

Re : Tri par couleur VBA

Parfait,c'est ce que je voulais. Autre petite question, pourquoi dans le programme ci dessous,il ne prend en compte que les deux dernières conditions?
If Cells(3, 2) = "" Then
Range("E55:E85").Value = ""
Else
Range("E55").Value = Sheets("Données CR").Cells(3, 3).Value
End If
If Cells(3, 2) = FAUX Then
Range("E55:E85").Value = ""
End If

If Cells(4, 2) = "" Then
Range("E55:E85").Value = ""
Else
Range("E55").Value = Sheets("Données CR").Cells(4, 3).Value
End If
If Cells(4, 2) = FAUX Then
Range("E55:E85").Value = ""
End If

Merci d'avance

 

[Efgé]

Re : Tri par couleur VBA

Bonjour ascarter, MatiChoux Bonjour J. BOISGONTIER_ Très tard mais j'avais préparé ceci...Sans connaitre le nombre final de couleurs. _ Cordialement _EDIT _Version (2) plus rapide (environ 10X)_Cordialement

 

[ascarter]

Re : Tri par couleur VBA

Merci Efgé,sa me permet de commencer à créer une base de données
A plus peut être