Suppressions des doublons non coloré

Verba_Tim

XLDnaute Occasionnel
Bonjour le fil :)

Je reviens vers vous parce que le passage de 2007 à 2003 est vraiment... violent... à s'en arracher les cheveux parfois :rolleyes:

J'en appel à votre savoir faire imcomparable ;)

Donc je suis en train de bosser sur un projet de macro simple (en théorie), qui me pose le problème suivant:

Je souhaite que ma macro me supprime les doublons d'une liste de donné, mais attention! Seulement les doublons non coloré en vert... ou n'importe lequel des deux si les deux sont coloré.

exemple:
xyz-000
xyz-000 (vert)
xyz-001 (vert)
xyz-001
xyz-002
xyz-003 (vert)
xyz-003 (vert)
abc-001
abc-001 (vert)


J'ai fait une petite macro qui me supprime les doublons parfaitement:
Code:
Sub Doublons()
Dim i As Integer, k As Integer, var As Integer

For i = 2 To Range("J65536").End(xlUp).Row
    var = 0
    nom1 = Range("J" & i).Value
 
    For k = i + 1 To Range("J65536").End(xlUp).Row
        nom2 = Range("J" & k).Value

        'If Range("J" & k).ColorIndex = 4 Then
           
     If nom2 = nom1 Then
                var = 1
                k = k - 1
                Rows(k).Delete 
            End If
       
    Next k

    If var = 1 Then Rows(k).Delete

Next i
End Sub

j'ai tenté la méthode
Code:
 'If Range("J" & k).ColorIndex = 4 Then
mais ça n'a pas l'air de fonctionné...


Aidez moi s'il vous plait :)



Ps: Va vraiment falloir que je fasse pression sur mes boss pour qu'ils passent en 2007 :eek:
 

Verba_Tim

XLDnaute Occasionnel
Re : Suppressions des doublons non coloré

Après test, ça fonctionne ^^ Par contre c'était bien le vert 4 que j'utilisais.
Si ça intéresse quelqu'un:
Code:
Sub Doublons()
Dim i As Integer, k As Integer, var As Integer

For i = 2 To Range("J65536").End(xlUp).Row
    var = 0
    nom1 = Range("J" & i).Value
    For k = i + 1 To Range("J65536").End(xlUp).Row
            nom2 = Range("J" & k).Value
            If nom2 = nom1 Then
                    If Not Range("J" & k).Interior.ColorIndex = 4 Then
                        var = 1
                        If Range("J" & k).Interior.ColorIndex = 4 Then
                        Rows(i).Delete
                        Else
                        Rows(k).Delete
                        End If
                    End If
                    If Range("J" & k).Interior.ColorIndex = 4 Then
                        k = k - 1
                        var = 1
                        Rows(k).Delete
                    End If
                    
            End If
    Next k

    If var = 1 Then Rows(k).Delete

Next i
End Sub

Voila :)

Bonne Après-midi à tous!
 

Robert

XLDnaute Barbatruc
Repose en paix
Re : Suppressions des doublons non coloré

Bonjour le fil, bonjour le forum.

Une autre proposition en passant par un tableau dynamique :
Code:
Sub Doublons()
Dim i As Integer, k As Integer
Dim nom1 As String, nom2 As String 'déclare les variables nom1 et nom2
Dim tl() As Long 'déclare le tableau de variables tl (Tableau Lignes)
Dim x As Long 'déclare la variable x (incrément)

For i = 2 To Range("J65536").End(xlUp).Row
    nom1 = Range("J" & i).Value
    For k = i + 1 To Range("J65536").End(xlUp).Row
        nom2 = Range("J" & k).Value
        If nom2 = nom1 Then
            ReDim Preserve tl(x) 'redimentionne le tableau de variable tl
            tl(x) = IIf(Cells(i, 10).Interior.ColorIndex = 4, k, i) 'récupère le numéro de ligne (k si i est verte, sinon i)
            x = x + 1 'incrémente x
        End If
    Next k
Next i
For x = UBound(tl) To LBound(tl) Step -1 'boucle inversée sur toutes les variable du tableau tl
    Rows(tl(x)).Delete 'supprime la ligne
Next x 'prochaine variable de la boucle
End Sub

p.s. Heureusement que mon boss ne nous impose pas cette m.... d'Excel 2007 et qu'on peut continuer à bosser avec 2003 !
 

herve62

XLDnaute Barbatruc
Supporter XLD
Re : Suppressions des doublons non coloré

Bonjour
Sur ton 1er code il y avait encore un Bug , si ta cellule verte était en doublon avec celle du dessous , elle ne se supprimait pas ( d'après ce que j'ai testé) ex : xyz001 (vert) et dessous xyz001
j'ai corrigé comme cela (testé OK)

Code:
Sub Doublons()
Dim i As Integer, k As Integer, var As Integer
For i = 2 To Range("J65536").End(xlUp).Row
    var = 0
    nom1 = Range("J" & i).Value
 
    For k = i + 1 To Range("J65536").End(xlUp).Row
        nom2 = Range("J" & k).Value
        If Range("J" & k).Interior.ColorIndex = 43 Then
           
     If nom2 = nom1 Then
                var = 1
                k = k - 1
                Rows(k).Delete
            End If
       End If
       
       If (nom2 = nom1 And Range("J" & k).Interior.ColorIndex <> 43) Then Rows(k).Delete
    Next k
    If var = 1 Then Rows(k).Delete
Next i
End Sub

A toi de voir
 

Verba_Tim

XLDnaute Occasionnel
Re : Suppressions des doublons non coloré

En effet j'ai pu remarqué quelques raté après test ^^ merci de vos propositions!!

-> Robert: Et bien moi je n'ai fait que bosser sur 2007, donc le retour à 2003 est assez difficile.... je ne retrouve plus mes fonctions favorites aussi facilement et parfois trouver une fonction toute bête deviens une expédition... Peu être est-ce aussi parce que ma version est en langue anglaise... x)
Aussi certaines fonctions n'existe pas sur le 2003 mais sur 2007 si... Comme par exemple le filtre par couleur de fond.... impossible de le trouver sous 2003 alors que sous 2007 il était très simple a utiliser x)
Je pense que c'est plus une question d'habitude que de logiciel en l'occurence. Comme le changement entre 2003 et 2007 est énorme il peut être difficile de retrouver certains automatisme en passant de l'un à l'autre. Pour ma part, j'ai été habitué à 2007... mal habitué? ;)

En tout cas merci à vous :)

Bonne journée!
 

Statistiques des forums

Discussions
311 733
Messages
2 082 019
Membres
101 872
dernier inscrit
Colin T