Doublons avec valeur inverse

Le
Cercle
Bonjour,

J'utilise régulièrement la macro MarqueLesDoublons trouvée sur Exelabo.
J'aimerais en créer une variante qui colorie uniquement une valeur et sa
valeur inverse si elle existe, ceci autant de fois qu'un chiffre positif est
compensé par un même chiffre négatif.

Je suis conscient que ce n'est pas un doublon, mais l'approche me semble
similaire. Par exemple, j'ai dans une colonne les chiffres suivants :

500
500
500
-500

Le résultat à obtenir est : une parmi les trois valeurs 500 et la
valeur -500 coloriées.

J'ai bien essayé de mettre une variable ii = i * -1 (ce qui ne fonctionne
pas parce que toutes les valeurs 500 sont coloriées)

J'ai excel 2007 et ma colonne contient environ 400 valeurs

Merci d'avance de bien vouloir m'aider


Voici la macro de Excelabo :

Sub MarqueLesDoublons()
Dim Plage As Range, i&, Cell As Range, Rng As Range

On Error Resume Next
Set Plage = Application.InputBox("Plage à examiner", Type:=8)
If IsEmpty(Plage) Then Exit Sub

Application.ScreenUpdating = False

For Each Cell In Plage
For i = 1 To Plage.Count
Set Rng = Cell.Offset(i)
If Rng <> "" And Rng = Cell Then
Cell.Interior.ColorIndex = 43
Rng.Interior.ColorIndex = 43
Exit For
End If
Next i
Next Cell
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
isabelle
Le #18881541
bonjour,

Sub MarqueLesDoublonsPositifNegatif()
Dim plg()
ReDim Preserve plg(1)
plg(1) = Cells(1, 1)
x = 1
For i = 2 To Range("A65536").End(xlUp).Row
If IsError(Application.Match(Cells(i, 1), plg, 0)) Then
x = x + 1
ReDim Preserve plg(x)
plg(x) = Cells(i, 1)
End If
Next

For i = LBound(plg) + 1 To UBound(plg)
x1 = Application.CountIf(Range("A1:A10"), plg(i))
y2 = Application.CountIf(Range("A1:A10"), plg(i) * -1)
w = Application.Min(x1, y2)
For y = 1 To Range("A65536").End(xlUp).Row
If Cells(y, 1) = plg(i) And t < w Then
t = t + 1
Cells(y, 1).Interior.ColorIndex = 43
End If
Next
t = 0
Next
End Sub

isabelle

Cercle a écrit :
Bonjour,

J'utilise régulièrement la macro MarqueLesDoublons trouvée sur Exelabo.
J'aimerais en créer une variante qui colorie uniquement une valeur et sa
valeur inverse si elle existe, ceci autant de fois qu'un chiffre positif est
compensé par un même chiffre négatif.

Je suis conscient que ce n'est pas un doublon, mais l'approche me semble
similaire. Par exemple, j'ai dans une colonne les chiffres suivants :

500
500
500
-500

Le résultat à obtenir est : une parmi les trois valeurs 500 et la
valeur -500 coloriées.

J'ai bien essayé de mettre une variable ii = i * -1 (ce qui ne fonctionne
pas parce que toutes les valeurs 500 sont coloriées)

J'ai excel 2007 et ma colonne contient environ 400 valeurs

Merci d'avance de bien vouloir m'aider


Voici la macro de Excelabo :

Sub MarqueLesDoublons()
Dim Plage As Range, i&, Cell As Range, Rng As Range

On Error Resume Next
Set Plage = Application.InputBox("Plage à examiner", Type:=8)
If IsEmpty(Plage) Then Exit Sub

Application.ScreenUpdating = False

For Each Cell In Plage
For i = 1 To Plage.Count
Set Rng = Cell.Offset(i)
If Rng <> "" And Rng = Cell Then
Cell.Interior.ColorIndex = 43
Rng.Interior.ColorIndex = 43
Exit For
End If
Next i
Next Cell





Cercle
Le #18881761
Bonjour,

Merci beaucoup Isabelle. Je teste aujourd'hui et je reviens ce soir.

Cordialement, Cercle




"isabelle" a écrit dans le message de news:
eS%
bonjour,

Sub MarqueLesDoublonsPositifNegatif()
Dim plg()
ReDim Preserve plg(1)
plg(1) = Cells(1, 1)
x = 1
For i = 2 To Range("A65536").End(xlUp).Row
If IsError(Application.Match(Cells(i, 1), plg, 0)) Then
x = x + 1
ReDim Preserve plg(x)
plg(x) = Cells(i, 1)
End If
Next

For i = LBound(plg) + 1 To UBound(plg)
x1 = Application.CountIf(Range("A1:A10"), plg(i))
y2 = Application.CountIf(Range("A1:A10"), plg(i) * -1)
w = Application.Min(x1, y2)
For y = 1 To Range("A65536").End(xlUp).Row
If Cells(y, 1) = plg(i) And t < w Then
t = t + 1
Cells(y, 1).Interior.ColorIndex = 43
End If
Next
t = 0
Next
End Sub

isabelle

Cercle a écrit :
Bonjour,

J'utilise régulièrement la macro MarqueLesDoublons trouvée sur Exelabo.
J'aimerais en créer une variante qui colorie uniquement une valeur et sa
valeur inverse si elle existe, ceci autant de fois qu'un chiffre positif
est compensé par un même chiffre négatif.

Je suis conscient que ce n'est pas un doublon, mais l'approche me semble
similaire. Par exemple, j'ai dans une colonne les chiffres suivants :

500
500
500
-500

Le résultat à obtenir est : une parmi les trois valeurs 500 et la
valeur -500 coloriées.

J'ai bien essayé de mettre une variable ii = i * -1 (ce qui ne
fonctionne pas parce que toutes les valeurs 500 sont coloriées)

J'ai excel 2007 et ma colonne contient environ 400 valeurs

Merci d'avance de bien vouloir m'aider


Voici la macro de Excelabo :

Sub MarqueLesDoublons()
Dim Plage As Range, i&, Cell As Range, Rng As Range

On Error Resume Next
Set Plage = Application.InputBox("Plage à examiner", Type:=8)
If IsEmpty(Plage) Then Exit Sub

Application.ScreenUpdating = False

For Each Cell In Plage
For i = 1 To Plage.Count
Set Rng = Cell.Offset(i)
If Rng <> "" And Rng = Cell Then
Cell.Interior.ColorIndex = 43
Rng.Interior.ColorIndex = 43
Exit For
End If
Next i
Next Cell







Cercle
Le #18889071
Bonjour,

J'ai testé la macro de Isabelle sur un fichier de plus de 300 lignes.

Elle fonctionne très bien.

Je vais lire les tutoriels pour bien comprendre le code.

Encore mille merci

Cercle
isabelle
Le #18891841
bonjour,

j'ai ajouté un Exit For à la macro pour éviter que la boucle tourne trop
longtemps pour rien,

Sub MarqueLesDoublonsPositifNegatif()
Dim plg()
ReDim Preserve plg(1)
plg(1) = Cells(1, 1)
x = 1
For i = 2 To Range("A65536").End(xlUp).Row
If IsError(Application.Match(Cells(i, 1), plg, 0)) Then
x = x + 1
ReDim Preserve plg(x)
plg(x) = Cells(i, 1)
End If
Next

For i = LBound(plg) + 1 To UBound(plg)
x1 = Application.CountIf(Range("A1:A10"), plg(i))
y2 = Application.CountIf(Range("A1:A10"), plg(i) * -1)
w = Application.Min(x1, y2)
For y = 1 To Range("A65536").End(xlUp).Row
If Cells(y, 1) = plg(i) And t < w Then
t = t + 1
Cells(y, 1).Interior.ColorIndex = 43
Else
Exit For
End If
Next
t = 0
Next
End Sub

isabelle

Cercle a écrit :
Bonjour,

J'ai testé la macro de Isabelle sur un fichier de plus de 300 lignes.

Elle fonctionne très bien.

Je vais lire les tutoriels pour bien comprendre le code.

Encore mille merci

Cercle






isabelle
Le #18891951
bonjour,

j'ai ajouté un Exit For à la macro pour éviter que la boucle tourne trop
longtemps pour rien,

Sub MarqueLesDoublonsPositifNegatif()
Dim plg()
ReDim Preserve plg(1)
plg(1) = Cells(1, 1)
x = 1
For i = 2 To Range("A65536").End(xlUp).Row
If IsError(Application.Match(Cells(i, 1), plg, 0)) Then
x = x + 1
ReDim Preserve plg(x)
plg(x) = Cells(i, 1)
End If
Next

For i = LBound(plg) + 1 To UBound(plg)
x1 = Application.CountIf(Range("A1:A10"), plg(i))
y2 = Application.CountIf(Range("A1:A10"), plg(i) * -1)
w = Application.Min(x1, y2)
For y = 1 To Range("A65536").End(xlUp).Row
If t = w Then Exit For
If Cells(y, 1) = plg(i) And t < w Then
t = t + 1
Cells(y, 1).Interior.ColorIndex = 43
End If
Next
t = 0
Next
End Sub


isabelle

Cercle a écrit :
Bonjour,

J'ai testé la macro de Isabelle sur un fichier de plus de 300 lignes.

Elle fonctionne très bien.

Je vais lire les tutoriels pour bien comprendre le code.

Encore mille merci

Cercle






Cercle
Le #18896351
Bonjour Isabelle,

Déjà, la première macro est très rapide. Je vais tester cette nouvelle macro
la semaine prochaine et je te tiendrai informée.

Je pense que je vais devoir ajouter des lignes pour voir la différence !

Quitte à me répéter, vraiment MERCI

Cercle
Publicité
Poster une réponse
Anonyme