comment faire pour supprimer les doublons?

[nsqualli]

Bonjour,

j'ai une macro qui fait un certain traitement, et qui me donne en output une liste (feuille jointe), sauf que dans cette liste y'a des lignes identiques.

est ce que vous pouvez me dire comment je peux faire pour supprimer les doublons, en laissant qu'une seule ligne biensur?

Merci

 

[skoobi]

Re : comment faire pour supprimer les doublons?

Bonjour nsqualli,

je t'invites à aller regarder dans ma signature.

 

[nsqualli]

Re : comment faire pour supprimer les doublons?

merci, mais moi j'ai besoin que le traitement soit excecuter dans ma macro, comme ça l'utilisateur n'aura pas a se soucier de remplir une formulaire ou autre chose.

mais merci comme meme

 

[BOISGONTIER]

Re : comment faire pour supprimer les doublons?

Bonsoir,

[B]Respecte l'ordre:[/B]

Sub supdoublons()
  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual
  Set champ = Range("A2:A" & [A65000].End(xlUp).Row)
  For i = [A65000].End(xlUp).Row To 1 Step -1
    If Application.CountIf(champ, Cells(i, 1)) > 1 Then Rows(i).Delete
  Next i
  Application.Calculation = xlAutomatic
End Sub

ou

[B]Tri en ordre croissant:[/B]

Sub supDoublonsTradi()
   Application.ScreenUpdating = False
   Application.Calculation = xlCalculationManual
   [A2].Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess
   For i = [A65000].End(xlUp).Row To 2 Step -1
     If Cells(i, 1) = Cells(i - 1, 1) Then Rows(i).Delete
   Next i
   Application.Calculation = xlCalculationAutomatic
End Sub

ou

Sub OrdreRespectéDictionaryRapide()
  Set MonDico = CreateObject("Scripting.Dictionary")
  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual
  i = 2
  Do While Cells(i, "A") <> ""
    If Not MonDico.Exists(Cells(i, "A") & Cells(i, "C")) Then
        MonDico.Add Cells(i, "A") & Cells(i, "C"), Cells(i, "A") & Cells(i, "C")
        i = i + 1
     Else
        Rows(i).EntireRow.Delete
     End If
  Loop
  Application.Calculation = xlCalculationAutomatic
End Sub

JB
Formation Excel VBA JB

 

[ROGER2327]

Re : comment faire pour supprimer les doublons?

Bonsoir à tous

Une proposition qui n'élimine que les enregistrements identiques (i.e. les lignes dont tous les champs sont identiques).

Sub supdoublons()
Dim i As Long, j As Long, k As Long, uS1 As Long, uS2 As Long, uD As Long, s As String, d As String
Dim Src(), Dst()
    Src = transpose(ThisWorkbook.Sheets("Imputation Retour Recette").Cells(1, 1).CurrentRegion.Value)
    uS1 = UBound(Src, 1)
    uS2 = UBound(Src, 2)
    uD = 1
    ReDim Dst(1 To uS1, 1 To uD)
    For i = 1 To uS1
        Dst(i, 1) = Src(i, 1)
    Next i
    For j = 1 To uS2
        s = ""
        For k = 1 To uS1
            s = s & "#" & Src(k, j)
        Next k
        For i = 1 To uD
            d = ""
            For k = 1 To uS1
                d = d & "#" & Dst(k, i)
            Next k
            If d = s Then Exit For
        Next i
        If i > uD Then
            uD = i
            ReDim Preserve Dst(1 To uS1, 1 To uD)
            For k = 1 To uS1
                Dst(k, uD) = Src(k, j)
            Next k
        End If
    Next j
    With ThisWorkbook.Sheets("Feuil1")
        .Range(.Cells(1, 1), .Cells(1, 1).Offset(uD - 1, uS1 - 1)).Value = transpose(Dst)
    End With
End Sub

Pour la tester, exécutez la procédure supdoublons et le résultat apparaitra dans la feuille Feuil1.​

Bonne nuit !
ROGER2327

 

[nsqualli]

Re : comment faire pour supprimer les doublons?

Salut boisgontier,

quand j'ai essayé ta premiere macro sur la feuille jointe ça marche tres bien, mais quand j'ai copié coller la macro dans mon classeur, et j'ai fais appel a elle de ma macro principale, j'ai une erreur de compilation: variable non definie pour la variable champ.

peux tu me dire pourquoi

merci

 

[nsqualli]

Re : comment faire pour supprimer les doublons?

Ok c'est bon,

Merci beaucoup a vous, j'ai travaillé avec la premiere macro de boisgontier, je devais juste definir les variables "champ" et "i" as range et as long.

Merci pour le temps que vous m'avez consacrer.