Autres Colorer doublons (Spécial)

kaki31 · 29 Mars 2021

Bonjour,
J'ai un petit souci pour colorer des doublons (valeur positive et négative) sur la colonne O, comme indiqué sur la colonne P.
Tout est dans l'exemple en pièce jointe.
Merci.

job75 · 29 Mars 2021

Bonsoir kaki31,

Puisque vous plaisantez je fais de même :

- sélectionner la colonne P, clic droit => Copier

- sélectionner la colonne O, clic droit => Collage spécial-Formats.

A+

kaki31 · 29 Mars 2021

Bonsoir job75,
je ne comprend pas votre réponse, dans la colonne P chaque chiffre positif a la même couleur qu’un même chiffre négatif, genre lettrage mais sans référence.
Merci.

Fred0o · 30 Mars 2021

Bonjour kki31, Job75.

@kaki31 : Je pense que ta plaisanterie vient du fait que ton exemple est tout sauf logique et dans ces conditions, aucune formule ni programme ne peut colorer les soi-disant doublons a ta place.
Voici en image, ce que j'appelle doublon :

job75 · 30 Mars 2021

Re, salut Fred0o,

En fait le problème est tout à fait cohérent mais kaki31 nous a entraînés sur une fausse piste en parlant de doublons.

Il s'agit en fait de colorer les paires de nombres de même valeur absolue mais de signes opposés.

Alors voyez le fichier .xlsm joint et cette macro dans le code de la feuille :

VB:

Private Sub Worksheet_Change(ByVal target As Range)
Dim couleur As Range, lig&, P As Range, rc&, i&, v, j&
Set couleur = Columns("Q").Cells 'colonne à adapter
lig = 2 '1ère ligne de couleur
If FilterMode Then ShowAllData
Set P = Range("O1", Range("O" & Rows.Count).End(xlUp)) 'colonne à adapter
rc = P.Rows.Count
Application.ScreenUpdating = False
P.Interior.ColorIndex = xlNone 'RAZ
For i = 1 To rc
    If IsNumeric(CStr(P(i))) And P(i).Interior.ColorIndex = xlNone Then
        v = -P(i)
        For j = i + 1 To rc
            If P(j) = v Then
                If P(j).Interior.ColorIndex = xlNone Then
                    Union(P(i), P(j)).Interior.Color = couleur(lig).Interior.Color
                    lig = lig + 1
                    If couleur(lig).Interior.ColorIndex = xlNone Then lig = 2 'on reprend les couleurs au début
                    Exit For
                End If
            End If
        Next j
    End If
Next i
End Sub

Elle se déclenche quand on modifie ou valide une cellule quelconque.

Elle n'est pas très rapide car la lecture des couleurs et les colorations prennent du temps.

A+

job75 · 30 Mars 2021

Avec un tableau des repères c'est un peu plus rapide, fichier (2) :

VB:

Private Sub Worksheet_Change(ByVal target As Range)
Dim couleur As Range, lig&, P As Range, rc&, a(), i&, v, j&
Set couleur = Columns("Q").Cells 'colonne à adapter
lig = 2 '1ère ligne de couleur
If FilterMode Then ShowAllData
Set P = Range("O1", Range("O" & Rows.Count).End(xlUp)) 'colonne à adapter
rc = P.Rows.Count
ReDim a(1 To rc) 'tableau des repères
Application.ScreenUpdating = False
P.Interior.ColorIndex = xlNone 'RAZ
For i = 1 To rc
    If IsNumeric(CStr(P(i))) And IsEmpty(a(i)) Then
        v = -P(i)
        For j = i + 1 To rc
            If P(j) = v Then
                If IsEmpty(a(j)) Then
                    a(j) = 1 'repère
                    Union(P(i), P(j)).Interior.Color = couleur(lig).Interior.Color
                    lig = lig + 1
                    If couleur(lig).Interior.ColorIndex = xlNone Then lig = 2 'on reprend les couleurs au début
                    Exit For
                End If
            End If
        Next j
    End If
Next i
End Sub

kaki31 · 30 Mars 2021

Merci job75

Autres Colorer doublons (Spécial)

kaki31

XLDnaute Occasionnel

Pièces jointes

job75

XLDnaute Barbatruc

kaki31

XLDnaute Occasionnel

Fred0o

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

Pièces jointes

job75

XLDnaute Barbatruc

Pièces jointes

kaki31

XLDnaute Occasionnel

Discussions similaires