Supprimer doublons particuliers (plage de cellule)

porcinet82

XLDnaute Barbatruc
Bonjour a tous,

Une nouvelle petite demande car je n'arrive pas a trouver un code simple (une macro...) pour faire ce que je veux.
Comme le titre l'indique, il s'agit de supprimer des doublons, mais ce ne sont pas des cellules qu'il faut comparer, mais des plages. Et c'est la que se pose le problème, je pourrais bien faire cellules par cellules, mais le fichier fait plus de 30 000 lignes et il y'a pas mal d'autres traitements qui prennent du temps, donc j'esperai que quelqu'un aurait un code simple ou rapide.

Toutes les explications se trouvent dans le fichier joint... Etant donné la vitesse des réponses a ma derniere demande, je vous remercie d'avance.

Petites précisions, je ne peux pas faire de tri car dans l'exemple, les colonnes ne sont pas nombreuses, mais il peut arriver qu'il y'en aient une vintaines...

@+

PS : Je send que c'est un truc tout con, mais...
 

Pièces jointes

  • Porcinet.xls
    22 KB · Affichages: 97
  • Porcinet.xls
    22 KB · Affichages: 102
  • Porcinet.xls
    22 KB · Affichages: 103

SergiO

XLDnaute Accro
Re : Supprimer doublons particuliers (plage de cellule)

Re, Romain

Je te propose un essai à tester sur un fichier + conséquent.
Je pense qu'il y a mieux à faire comme comparaison mais pour l'instant, c'est la seule idée que j'ai eue.

Code:
Sub Test()
Application.ScreenUpdating = False
DerLig = Range("A65536").End(xlUp).Row
For L = DerLig To 1 Step -2
    Chaine1 = "|"
    Dercol = Cells(L - 1, 256).End(xlToLeft).Column
        For C = 1 To Dercol
        Chaine1 = Chaine1 & Cells(L - 1, C) & "|"
        Next C
    Dercol = Cells(L, 256).End(xlToLeft).Column
        For C = 1 To Dercol
        Chaine1 = Chaine1 & Cells(L, C) & "|"
        Next C
            For I = 1 To L - 2 Step 2
            Chaine2 = Chaine1
            Dercol = Cells(I, 256).End(xlToLeft).Column
                For J = 1 To Dercol
                Compare = Cells(I, J)
                Chaine2 = Replace(Chaine2, Compare, "", 1, 1)
                Next J
                Dercol = Cells(I + 1, 256).End(xlToLeft).Column
                    For J = 1 To Dercol
                    Compare = Cells(I + 1, J)
                    Chaine2 = Replace(Chaine2, Compare, "", 1, 1)
                    Next J
                    Chaine2 = Replace(Chaine2, "|", "", 1)
                    If Chaine2 = "" Then
                    Rows(L).Delete
                    Rows(L - 1).Delete
                    I = I + 2
                    End If
            Next I
Next L
Application.ScreenUpdating = False
End Sub

@+
 

porcinet82

XLDnaute Barbatruc
Re : Supprimer doublons particuliers (plage de cellule)

re Bonsoir Sergio,

Je te remercie de ta réponse, je ne peux pas tester car le fichier est au taf et que la journée est terminée ;), mais je teste rapidement et te tiens au courant du résultat.
J'étais parti sur un code de ce genre sans toutefois aller au bout car je voyais l'usine a gaz arriver a grand pas !!!!
Mais je me disais qu'il y avait surement plus simple, peut etre via les tableaux qui permettent directement de ne pas avoir de doublons lorsque l'on stock des cellules.
Sinon, je me suis dit peut etre via un Set Plage, ou peut etre qu'il existe une fonction que je ne connais pas...

En tout cas merci de t'etre plongé sur mon problème et j'espère pouvoir te rendre l'appareil !!!

Au plaisir,

@+
 

SergiO

XLDnaute Accro
Re : Supprimer doublons particuliers (plage de cellule)

Re Romain

Suite à ta précédente réponse, j'ai trouvé ceci comme exemple pour comparer 2 plages

Code:
 Sub ComparePlages()
Dim Arr1, Arr2, Flag
  Arr1 = Range("A1:D500").Value
  Arr2 = Range("F1:I500").Value
  Flag = True
  For i = LBound(Arr1, 2) To UBound(Arr1, 2)
    For j = LBound(Arr1, 1) To UBound(Arr1, 1)
      If Not Arr1(j, i) = Arr2(j, i) Then
        Flag = False: Exit For
      End If
    Next j
    If Not Flag Then Exit For
  Next i
  MsgBox "Plages identiques : " & Flag
End Sub
End Sub
Voici le lien Ce lien n'existe plus

Peut-être une piste à suivre en faisant varier Arr1 et Arr2.
Je regarde de mon côté dès que j'ai un moment.

Bonne soirée
 

porcinet82

XLDnaute Barbatruc
Re : Supprimer doublons particuliers (plage de cellule)

Salut Sergio,

En tout cas merci d'avoir fait des recherches qui se sont avérées plus fructueuses que les miennes. je viens d'essayer ton premier code qui fonctionne, mais avec en pas mal de temps comme je m'y attendais, j'ai pas chronométrer, mais a la louche, je dirai entre 5 et 6 min...

Sinon, je vais regarder le dernier code que tu m'as proposé sur la comparaison des plages, et si j'arrive a la modifier comme il faut, je te vous tiens au courant.

@+
 

Discussions similaires

Statistiques des forums

Discussions
312 323
Messages
2 087 300
Membres
103 512
dernier inscrit
sisi235