Tableau et doublon

[Seb]

Bonjour le forum,

Je viens vers vous pour m'aider à trouver comment supprimer des doublons dans un très grand tableau excel.

J'ai plusieurs feuilles avec minimum de 40000 lignes.
J'ai des macros qui insèrent des lignes au fur et à mesure, je cherche un moyen rapide pour supprimer les doublons dans chaque feuille à chaque fois que la macro qui insère des données tourne.

J'ai essayer par boucle mais au bout de 10 min, j'ai du stopper la macro ... ;(

je cherchais par le biais des tableau à plusieurs dimensions mais je trouve vraiment pas.

Les doublons ne doivent etre testé que sur la 1ere colone ( la réf de la ligne).

Je joins un tableau ( La macro ne marchera pas car elle à besoin d'autre fichier ouvert )

Merci à vous !

 

[joss56]

Re : Tableau et doublon

Bonjour Seb, le forum,

Pas certain de bien comprendre mais pourquoi ne pas utiliser la commande "Supprimer les doublons" d'Excel (disponible depuis la version 2007) ?

Jocelyn

 

[Seb]

Re : Tableau et doublon

Bonjour Jocelyn,

Je travaille avec le 2003 ;(

Je cherche surtout à tout automatiser car les personnes qui utiliserons ce tableau ne connaissent pas excel.

 

[joss56]

Re : Tableau et doublon

Alors une petite procédure à adapter et tester...

Private Sub CommandButton1_Click()
Dim i As Integer, k As Integer, var As Integer
Dim nom1 As String, nom2 As String

For i = 1 To Range("A65536").End(xlUp).Row

nom1 = Range("A" & i).Value

For k = i + 1 To Range("A65536").End(xlUp).Row
nom2 = Range("A" & k).Value

If nom2 = nom1 Then
Rows(k).Delete
k = k - 1
End If

Next k
Next i

End Sub

 

[Seb]

Re : Tableau et doublon

J'avais deja fait une procédure comme celle la, mais mon tableau est beaucoup trop grand et elle est trop longue. Je cherchais une macro sous forme de tableau mais je sais pas comment m'y prendre.

 

[Seb]

Re : Tableau et doublon

J'ai reussi à bidouiller ca mais je n'arrive pas à avoir toutes les données:


Sub SupprimeDoublons()
For feuille = 1 To Sheets.Count
If Sheets(feuille).Name <> "Accueil" Then
Sheets(feuille).Activate
Set mondico = CreateObject("Scripting.Dictionary")
For Each C In Range("a2", [a65000].End(xlUp))
mondico(C.Value) = ""
Next C
[Z2].Resize(mondico.Count, 1) = Application.Transpose(mondico.keys)
End If
Next
End Sub


Comment concerver toutes les données des autres colones ? Car je n'arrive à transposer que la colone A

 

[gosselien]

Re : Tableau et doublon

Bonjour,


un essai (imparfait) avec dico:

P.

Sub Unik()
Dim Tblo(), i As Long, Dico As Object
Set Dico = CreateObject("Scripting.Dictionary")
Tblo = Range("A2:L" & Cells(Rows.Count, 3).End(3).Row)
For i = 1 To UBound(Tblo)
  If Dico.exists(Tblo(i, 1)) Then
    Tblo(Dico(Tblo(i, 1)), 2) = Tblo(Dico(Tblo(i, 1)), 2)
  Else
    x = x + 1
    Tblo(x, 1) = Tblo(i, 1)
    Tblo(x, 2) = Tblo(i, 2)
    Tblo(x, 3) = Tblo(i, 3)
    Tblo(x, 4) = Tblo(i, 4)
    Tblo(x, 5) = Tblo(i, 5)
    Tblo(x, 6) = Tblo(i, 6)
    Tblo(x, 7) = Tblo(i, 7)
    Tblo(x, 8) = Tblo(i, 8)
    Tblo(x, 9) = Tblo(i, 9)
    Tblo(x, 10) = Tblo(i, 10)
    Tblo(x, 11) = Tblo(i, 11)
    Tblo(x, 12) = Tblo(i, 12)
    Dico(Tblo(i, 1)) = x
  End If
Next i
[N2].Resize(x, 11) = Tblo
End Sub

 

[klin89]

Re : Tableau et doublon

Bonsoir gosselien, Seb, joss56, le forum

Il faut donc traiter toutes les feuilles sauf la 1ère, c'est bien ça !

Teste cette macro.
Pour éviter les bétises, je surligne les lignes à supprimer

Option Explicit

Sub supprime()
Dim i As Long, r As Range, x As Range
    With CreateObject("Scripting.Dictionary")
        .CompareMode = 1
        For i = Worksheets.Count To 2 Step -1
            Sheets(i).UsedRange.Interior.ColorIndex = xlNone
            For Each r In Sheets(i).UsedRange.Columns(1).Cells
                If Not .exists(r.Value) Then
                    .Item(r.Value) = Empty
                Else
                    If x Is Nothing Then
                        Set x = r.EntireRow
                    Else
                        Set x = Union(x, r.EntireRow)
                    End If
                End If
            Next
            .RemoveAll
            'Supprime les lignes en double
            'If Not x Is Nothing Then x.Delete
            'Surligne les ligne en double
            If Not x Is Nothing Then x.Interior.ColorIndex = 43
            Set x = Nothing
        Next
    End With
End Sub

klin89

 

[Seb]

Re : Tableau et doublon

Bonsoir Klin89,

Impeccable !!!! Carrément ! Ca marche du tonnerre !!! Tu m'as enlevé un épine du pied la !

Merci à Gosselien et Joss56 aussi !


Vraiment merci !!!!