Comment coloriser les doublons et unique avec VBA

Bonjour,

Je suis nouveau dans ce forum, j'espere que je suis dans la bonne file!!

je souhaiterais mettre des couleurs a des doublons et dautres aux communs.

Sans passer par MFC, mais par macro VBA ou formule excel "il parait non possible".

ce ne sont que des numeros.

je ne connais pas la progrmation VBA, mais j'ai essayé la macro!!!

Merci a vous pour les reponses futures

Bonjour,

Tu est dans la bonne "file"

A essayer..

A+

MERCI

JE VAIS REGARDER ET TE DIRE SI CEST OK

MERCI POUR LE TEMPS QUE TU AS PASSEES

Lermite,

Tout est ok sauf a partir de la 3 iem ligne des chiffres en bleu au lieu de rouge

OK 1 ligne

OK 2 ligne

35 3 ligne

2 7 35 42 48 4 ligne

35 39 42 5 ligne

2 11 39 42 57 6 ligne

8 11 35 39 7ligne

35 42 48 59 8 ligne

7 11 35 48 57 9 ligne

2 11 35 10 ligne

Merci encore pour ton travail

je t'envoie fichier d e comparaison

Beh oui, Mais y faut choisir, y a des nombres qui sont commun à la ligne 1 ET 2, si tu veux l'inverse et bien inverse les deux dernière lignes de la macro.

A+

Lermite, désolé

j'ai simplement oublie qu'a partir de la ligne 3 a 10 il faut aussi :

si commun avec ligne 1 alors en rouge.

Dis moi juste le code que je dois ajouter.

Merci meaculpa

Mais oui, c'est comme j'ai dis, tu inverse ces deux lignes

        If R <> "" Then .Range(Mid(R, 2)).Font.ColorIndex = Rouge
        If R2 <> "" Then Range(Mid(R2, 2)).Font.ColorIndex = Bleu

pour avoir

        If R2 <> "" Then Range(Mid(R2, 2)).Font.ColorIndex = Bleu
        If R <> "" Then .Range(Mid(R, 2)).Font.ColorIndex = Rouge

A+

Super Lermite!!!

Merci

Bonjour à tous,

Une variante avec la fonction Find

Sub ColoreCommuns()
Dim Lg&, i%, L%
Dim R As Range 'rouge
Dim B As Range 'bleu
    Application.ScreenUpdating = False
    Lg = Range("a" & Rows.Count).End(xlUp).Row

    For L = 3 To Lg                 'lignes
      If Range("a" & L) <> "" Then
        Rows(L).Font.ColorIndex = 1                                                 'remet en noir
        For i = 1 To 20             '(20 = colonne T)
            Set R = Rows(1).Find(Cells(L, i), LookIn:=xlValues, Lookat:=xlWhole)    'ligne1
            Set B = Rows(3).Find(Cells(L, i), LookIn:=xlValues, Lookat:=xlWhole)    'ligne3
            '--- si commun aux lignes 1 et 2, le rouge écrase le bleu ---
            If Not B Is Nothing Then Cells(L, i).Font.ColorIndex = 33               'bleu ciel
            If Not R Is Nothing Then Cells(L, i).Font.ColorIndex = 3                'rouge
        Next i
      End If
    Next L
End Sub

Amicalement

Claude

Merci Dubois,

mais j'ai déja le code pour cela grace a Lermite, je voudrais juste finir avec

tous les n° rouge ensemble et a la suite idem pour les bleu et noir

Ci-joint le fichier

Bonjour à tous,

en partant de ton dernier fichier,

voir Module "Ligne32"

Sub TableauLigne32()
Dim Lg%, A%, i%, cL%
    Application.ScreenUpdating = False
    Cells(32, 1).Resize(11, 23).Clear
    Cells(42, 1).Resize(1, 23) = "test"
    '--- copie sur colonnes 1, 9 et 17 (ligne 43 temporaire)---
    For A = 1 To 10         'colonnes
        For i = 20 To 26    'lignes
             Select Case Cells(i, A).Font.ColorIndex
                Case Is = 3: cL = 1
                Case Is = 33: cL = 9
                Case Else: cL = 17
            End Select
            Cells(i, A).Copy Destination:=Cells(Rows.Count, cL).End(xlUp)(2)
        Next i
    Next A
    '--- Tableaux ligne 32 ---
    For A = 1 To 17 Step 8
        cL = A
        Lg = Cells(Rows.Count, cL).End(xlUp).Row
            For i = 43 To Lg Step 10
                Cells(i, A).Resize(10, 1).Cut Destination:=Cells(32, cL)
                cL = cL + 1
            Next i
    Next A
    Rows(42).Clear
End Sub

si pas çà, retire le résolu pour continuer.

Amicalement

Claude

Super Claude

Merci mille fois, grace a toi l programme est terminé

Je n'oublie pas aussi Lermite qui super bien demarer

Merci encore a vous Deux.

Frantz