supprimer doublons

[obyone]

bonjour

j'ai 2 boutons dans mon classeur 1 pour les mise à jour et 1 pour les doublons,

j'aimerais inclure la supressions des doublons dans la mise à jour mais cela fonctionne pas, est-ce que quelqu'un peu m'aider?

merci

 

[M12]

Re : supprimer doublons

Bonjour,

Remplace dans le module 1 avec ce code
J'ai mis des apostrophes devant le code du Msgbox 'Mise à jour à faire"

Sub Bouton2_Clic()

With Worksheets("Feuil1").Range("Tableau3")
Maj = False
    For i = 1 To .Rows.Count
        If .Item(i, 1) <> .Item(i, 3) Or .Item(i, 2) <> .Item(i, 4) Then
            Maj = True
            nb = Range("MAJ").Rows.Count + 1
            Range("MAJ").Item(Range("MAJ").Rows.Count, 2) = "essai"
            Range("MAJ").Item(Range("MAJ").Rows.Count, 3) = .Item(i, 1)
            Range("MAJ").Item(Range("MAJ").Rows.Count, 5) = .Item(i, 3)
            Range("MAJ").Item(Range("MAJ").Rows.Count, 4) = .Item(i, 2)
            Range("MAJ").Item(Range("MAJ").Rows.Count, 6) = .Item(i, 4)
            

            Sheets("MAJ").ListObjects("MAJ").Resize Range("A1:F" & nb + 1)
        
        End If
    Next i
End With

With Worksheets("MAJ")

    choix = "1"
    der_ligne = Range("c" & "65000").End(xlUp).Row
 
    Dim tab_cells()
    ReDim tab_cells(der_ligne - 1)
 
    For ligne = 1 To der_ligne
        tab_cells(ligne - 1) = Range("c" & ligne)
    Next
 
    nb = 0
    If choix = 1 Then compteur = 0
 
    For ligne = 1 To der_ligne
        contenu = tab_cells(ligne - 1)
  
        If (choix = 1) And ligne > 1 And contenu <> "" Then 'Effacer/supprimer doublons
            For i = 1 To ligne - 1
                If contenu = tab_cells(i - 1) Then 'Si doublon
                    nb = nb + 1
                    Range(ligne & ":" & ligne).ClearContents
                    Range(ligne + compteur & ":" & ligne + compteur).Delete
                    compteur = compteur - 1
                End If
            Next
        End If
    Next
 End With
 
    'If Maj Then
    'MsgBox ("Mise à jour à faire")
    'Else: MsgBox ("Aucune Mise à jour")
    'End If
    
    Sheets("MAJ").Activate
     choix = "1"
    der_ligne = Range("c" & "65000").End(xlUp).Row
 
    
    ReDim tab_cells(der_ligne - 1)
 
    For ligne = 1 To der_ligne
        tab_cells(ligne - 1) = Range("c" & ligne)
    Next
 
    nb = 0
    If choix = 1 Then compteur = 0
 
    For ligne = 1 To der_ligne
        contenu = tab_cells(ligne - 1)
  
        If (choix = 1) And ligne > 1 And contenu <> "" Then 'Effacer/supprimer doublons
            For i = 1 To ligne - 1
                If contenu = tab_cells(i - 1) Then 'Si doublon
                    nb = nb + 1
                    Range(ligne & ":" & ligne).ClearContents
                    Range(ligne + compteur & ":" & ligne + compteur).Delete
                    compteur = compteur - 1
                End If
            Next
        End If
    Next
End Sub

 

[Paritec]

Re : supprimer doublons

Bonjour Obyone le forum
ton fichier en retour
quand tu utilises with sheets("xxxx") il ne faut pas oublier les points !!!!!! du style .Range("c" & ligne)
autrement le Range("c" & ligne) va s'exécuter sur la feuille active donc la feuille de ton bouton 2!!
a+
Papou

 

[obyone]

Re : supprimer doublons

bonjour,

merci à vous 2 ca fonctionne, encore un probleme de "syntaxe" merci de me faire remarquer paritec, ca me fait progresser.

bonne fin journée
Oby1