supprimer doublons sur 40000 lignes

[eillon]

Bonjour,

Je recherche un "truc" un peu complexe, sur deux listes de 20 000 lignes, il faut que je dégage les doublons et comparer si les restant appartiennent à la liste 1 ou 2.

Je peux mettre les lignes sur colonnes A et B de la même feuille.

En fait je voudrais déplacer les doublons colonnes A et B en Feuil2 et qu'il reste dans chaque colonne Feuil1 les uniques correspondant aux colonnes.

 

[skoobi]

Re : supprimer doublons sur 40000 lignes

Bonjour le fil,
suis tout à fait d'accord avec toi bhbh, ça fait pas très plaisir de voir ses macros commentées ailleurs. Ca fait un peu genre ils ont pas trouvé la solution, je vais voir ailleurs
Mais bon, on ne sais pas toujours sur qui on tombe.
Merci papapaul, ça fait chaud au coeur

"Edit : jeanpierre, on dirait que je suis de moins bonne humeur que toi"
mdr

Staple1600, la position sss ......... euf?

 

[eillon]

Re : supprimer doublons sur 40000 lignes

Je suis vraiment désolé, j'aurais dû en parler plus tôt, j'ai corrigé mon erreur et cité le posteur de la macro sur l'autre forum, j'avais posté sur les deux forum en même temps (à quelques minutes prêts).

Encore toutes mes excuses.

 

[Staple1600]

Re : supprimer doublons sur 40000 lignes

Bonjour


...j'aime aussi la multiprise...


Tréve de plaisanterie


Pour accélérer le code:

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
' le code de ta macro
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

 

[Bisson]

Re : supprimer doublons sur 40000 lignes

Bonjour,

0,6s pour 2x10.000 éléments:

Sub Communs()
 Set MonDico1 = CreateObject("Scripting.Dictionary")
  For Each c In Range([A1], [A65000].End(xlUp))
    If Not MonDico1.Exists(c.Value) Then MonDico1.Add c.Value, c.Value
  Next c
  Set mondico2 = CreateObject("Scripting.Dictionary")
  For Each c In Range([B1], [B65000].End(xlUp))
    If MonDico1.Exists(c.Value) Then mondico2.Add c.Value, c.Value
  Next c
  i = 1
  Range("H1:H" & mondico2.Count) = Application.Transpose(mondico2.items)
End Sub

Non communs1:

Sub NonDoublons1()
 Set MonDico1 = CreateObject("Scripting.Dictionary")
  For Each c In Range([A1], [A65000].End(xlUp))
    If Not MonDico1.Exists(c.Value) Then MonDico1.Add c.Value, c.Value
  Next c
  Set mondico2 = CreateObject("Scripting.Dictionary")
  For Each c In Range([B1], [B65000].End(xlUp))
    If Not MonDico1.Exists(c.Value) Then
       mondico2.Add c.Value, c.Value
    End If
  Next c
  Range("M1:M" & mondico2.Count) = Application.Transpose(mondico2.items)
End Sub

Non Communs2:

Sub NonDoublons2()
 Set MonDico1 = CreateObject("Scripting.Dictionary")
  For Each c In Range([B1], [B65000].End(xlUp))
    If Not MonDico1.Exists(c.Value) Then MonDico1.Add c.Value, c.Value
  Next c
  Set mondico2 = CreateObject("Scripting.Dictionary")
  For Each c In Range([A1], [A65000].End(xlUp))
    If Not MonDico1.Exists(c.Value) Then
       mondico2.Add c.Value, c.Value
    End If
  Next c
  Range("P1:P" & mondico2.Count) = Application.Transpose(mondico2.items)
End Sub

Bisson

 

[eillon]

Re : supprimer doublons sur 40000 lignes

2 fois merci Bisson, mais ça bloque sur

mondico2.Add c.Value, c.Value

dans la dernière macro "nondoublon2"

 

[Bisson]

Re : supprimer doublons sur 40000 lignes

S'il y a des doublons à l'intérieur de cacule des listes:

Sub Communs()
 Set MonDico1 = CreateObject("Scripting.Dictionary")
  For Each c In Range([A1], [A65000].End(xlUp))
    If Not MonDico1.Exists(c.Value) Then MonDico1.Add c.Value, c.Value
  Next c
  Set mondico2 = CreateObject("Scripting.Dictionary")
  For Each c In Range([B1], [B65000].End(xlUp))
    If MonDico1.Exists(c.Value) Then
      If Not mondico2.Exists(c.Value) Then mondico2.Add c.Value, c.Value
    End If
  Next c
  i = 1
  Range("H1:H" & mondico2.Count) = Application.Transpose(mondico2.items)
End Sub

Sub NonDoublons1()
 Set MonDico1 = CreateObject("Scripting.Dictionary")
  For Each c In Range([A1], [A65000].End(xlUp))
    If Not MonDico1.Exists(c.Value) Then MonDico1.Add c.Value, c.Value
  Next c
  Set mondico2 = CreateObject("Scripting.Dictionary")
  For Each c In Range([B1], [B65000].End(xlUp))
    If Not MonDico1.Exists(c.Value) Then
       If Not mondico2.Exists(c.Value) Then mondico2.Add c.Value, c.Value
    End If
  Next c
  Range("M1:M" & mondico2.Count) = Application.Transpose(mondico2.items)
End Sub

Sub NonDoublons2()
 Set MonDico1 = CreateObject("Scripting.Dictionary")
  For Each c In Range([B1], [B65000].End(xlUp))
    If Not MonDico1.Exists(c.Value) Then MonDico1.Add c.Value, c.Value
  Next c
  Set mondico2 = CreateObject("Scripting.Dictionary")
  For Each c In Range([A1], [A65000].End(xlUp))
    If Not MonDico1.Exists(c.Value) Then
       If Not mondico2.Exists(c.Value) Then mondico2.Add c.Value, c.Value
    End If
  Next c
  Range("P1:P" & mondico2.Count) = Application.Transpose(mondico2.items)
End Sub

Bisson

 

[eillon]

Re : supprimer doublons sur 40000 lignes

ça marche parfaitement bien merci à tous.