Suppression doublon en ligne mais pas en colonne

[maxis6582]

Bonjour, je suis confronté à un petit problème, je doit supprimer des cellules identiques dans une même ligne, et décaler vers la gauche le reste des cellules pour ne pas avoir de vide. Les doublons en colonne ne doivent pas être supprimés.
Excel propose la suppression de doublon en colonne mais pas en ligne (en tous cas je n'ai rien vu qui laisserais penser le contraire...). J'ai bien penser à transposer pour faire le traitement, mais le nombre maxi de colonne est très vite atteint.

Y a t'il une solution prévu dans excel? Dans le cas contraire, je suis novice et n'arriverais pas à coder seul pour arriver à mes fins...

En PJ un exemple de fichier

Merci par avance pour votre aide.

 

[maxis6582]

Re : Suppression doublon en ligne mais pas en colonne

Désolé ,j'ai effacer mon post, je pensais avoir trouver la solution mais... non

 

[maxis6582]

Re : Suppression doublon en ligne mais pas en colonne

Quelqu'un aurait-il une idée? SVP

merci par avance

 

[maxis6582]

Re : Suppression doublon en ligne mais pas en colonne

Petite relance du post, je deviens fou avec ce problème...

 

[mapomme]

Re : Suppression doublon en ligne mais pas en colonne

Bonsoir maxis6582,

Un essai dans le fichier joint. Le code est dans module1.

Edit: je n'avais pas vu la contrainte du nombre de lignes/colonnes, je remets l'ouvrage sur le métier @+

Sub SuppDoublon()
Dim shaux As Worksheet, shact As Worksheet, xrg As Range
  Application.ScreenUpdating = False
  Set shact = ActiveSheet
  Set shaux = ThisWorkbook.Sheets.Add
  With shaux
    shact.Range("A1").CurrentRegion.Copy
    .Range("A1").PasteSpecial , , , True
    For Each xrg In .Range("A1").CurrentRegion.Columns
      xrg.RemoveDuplicates Columns:=1, Header:=xlYes
    Next xrg
    shact.Range("A1").CurrentRegion.Clear
    .Range("A1").CurrentRegion.Copy
    shact.Range("A1").PasteSpecial , , , True
    .Application.DisplayAlerts = False
    .Delete
    Application.DisplayAlerts = True
  End With
  Application.Goto shact.Range("A1"), True
  Application.ScreenUpdating = True
End Sub

 

[mapomme]

Re : Suppression doublon en ligne mais pas en colonne

(re)Bonsoir maxis6582

Un autre essai avec un nombre de lignes supérieur au nombre 16384 de colonnes possible. L'exécution risque d'être un peu longue...

Sub SuppDoublon()
Const pas = 16384
Dim shaux As Worksheet, shact As Worksheet, xrg As Range
Dim lig&, col&, i&, deb&, fin&, T0 As Single

  T0 = Timer
  Application.ScreenUpdating = False
  Set shact = ActiveSheet
  Set xrg = shact.Range("A1").CurrentRegion
  lig = xrg.Rows.Count: col = xrg.Columns.Count
  Set shaux = ThisWorkbook.Sheets.Add
  deb = 1
  
With shaux
  Do
    With shact
      fin = IIf(deb + pas > lig, lig, deb + pas - 1)
      .Range(.Cells(deb, 1), .Cells(fin, col)).Copy
    End With
    
    .Range("A1").PasteSpecial , , , True
    For Each xrg In .Range("A1").CurrentRegion.Columns
      xrg.RemoveDuplicates Columns:=1, Header:=xlYes
    Next xrg
    shact.Range(shact.Cells(deb, 1), shact.Cells(fin, col)).Clear
    .Range("A1").CurrentRegion.Copy
    shact.Cells(deb, 1).PasteSpecial , , , True
    .Cells.Delete
    deb = fin + 1
  Loop Until deb > lig
  .Application.DisplayAlerts = False
  .Delete
  Application.DisplayAlerts = True
End With

  Application.Goto shact.Range("A1"), True
  Application.ScreenUpdating = True
  MsgBox "Durée: " & Format(Timer - T0, "0.0 sec")
End Sub

 

[Yaloo]

Re : Suppression doublon en ligne mais pas en colonne

Bonsoir à vous 2,

Avec des boucles, risque d'être beaucoup plus long que la proposition de mapomme, mais bon ...

Option Explicit
Sub Sup_Doublon()
Dim c&, i&, j&, l&
Application.ScreenUpdating = 0
j = [A65536].End(xlUp).Row
For i = 2 To j
  c = Cells(i, Columns.Count).End(xlToLeft).Column
  For l = c To 2 Step -1
    If Application.CountIf(Rows(i), Cells(i, l)) > 1 Then Cells(i, l).Delete Shift:=xlToLeft
  Next
Next
Application.ScreenUpdating = -1
End Sub

A+

 

[BOISGONTIER]

Re : Suppression doublon en ligne mais pas en colonne

Bonjour,

cf PJ

Sub supDoublons()
 For i = 1 To [A65000].End(xlUp).Row
   a = Cells(i, 1).Resize(, Cells(i, "IV").End(xlToLeft).Column).Value
   Set d = CreateObject("Scripting.Dictionary")
   For Each c In a: d(c) = "": Next c
   Sheets("result").[a1].Offset(i).Resize(, d.Count) = d.keys
 Next i
End Sub

JB

 

[mapomme]

Re : Suppression doublon en ligne mais pas en colonne

Bonjour maxis6582, Yaloo, BOISGONTIER,

Après différents essais, voici la mouture la plus rapide que j'ai pu construire. Elle nécessite l'activation de la référence à "Microsoft Scripting RunTime". Pour cela:
.

• Se placer dans l'éditeur VBA (touches Alt+F11)
• Sélectionner le menu "Outils / Références..."
• Dans la boîte de dialogue, chercher "Microsoft Scripting RunTime"
• Cocher la case correspondante (si ce n'est pas déjà le cas) puis cliquer sur "OK"

nota 1: il faut d'abord créer les lignes à traiter en cliquant sur le 1ier bouton.
nota 2: sur ma vieille bécane, env 6 sec. par tranche de 100 000 lignes.
nota 3: la macro supprime les cellules vides si il y en avait dans le tableau initial.
nota 4: en fonction de la mémoire dont on dispose et de la longueur des lignes, on pourra augmenter ou devoir diminuer la valeur de la constante pas.

le code:

Option Explicit

Sub SuppDoublonMP()
Const pas = 16384
Dim shact As Worksheet, xrg As Range
Dim lig&, col&, i&, j&, k&, deb&, fin&, t0 As Single
Dim dico As New Dictionary, T

  t0 = Timer
  Application.ScreenUpdating = False
  Set shact = ActiveSheet
  Set xrg = shact.Range("A1").CurrentRegion
  lig = xrg.Rows.Count: col = xrg.Columns.Count
  deb = 1
  
  With shact
    Do
      fin = IIf(deb + pas > lig, lig, deb + pas - 1)
      T = .Range(.Cells(deb, 1), .Cells(fin, col)).Value
      For i = 1 To fin + 1 - deb
        dico.RemoveAll
        k = 0
        For j = 1 To col
          If T(i, j) <> "" Then
            If Not dico.Exists(T(i, j)) Then
              k = k + 1
              T(i, k) = T(i, j)
              dico.Add T(i, j), ""
            End If
          End If
        Next j
        For j = k + 1 To col
          T(i, j) = ""
        Next j
      Next i
      .Range(.Cells(deb, 1), .Cells(fin, col)).Clear
      .Range(.Cells(deb, 1), Cells(fin, col)).Value = T
      deb = fin + 1
    Loop Until deb > lig
  End With

  Application.Goto shact.Range("A1"), True
  Application.ScreenUpdating = True
  MsgBox "Durée: " & Format(Timer - t0, "0.0 sec")

End Sub

 

[maxis6582]

Re : Suppression doublon en ligne mais pas en colonne

Hé bien avec tout ça... J'ai tester le code nécessitant run time et tout fonctionne parfaitement. les données sont très nombreuses mais le traitement à durer 5 secondes seulement.

Merci à tous les 3 pour votre contribution.

Avec tout les travaux différents que je doit réaliser sur excel, je n'imagine pas le temps gagner si j'avais vos compétences.
merci encore et bonne journée.