Macro - Supprimer doublon

Le 13/02/2024 à 18:40

Hello tout le monde,

dans le fichier suivant, j''aimerais réaliser une macro qui va :
- Supprimer les doublons d'un onglet du classeur spécifié en E4 de l'onglet ''Paramètres''
- Le max de colonnes sera de la colonne A à Z

pour se faire j'ai écris ce code :

Sub SupprimerDoublons()
Dim wsParam As Worksheet
Dim wsCible As Worksheet
Dim nomOnglet As String

' Référence à l'onglet "Paramètres"
Set wsParam = ThisWorkbook.Sheets("Paramètres")

' Lecture du nom de l'onglet cible depuis la cellule E4 de l'onglet "Paramètres"
nomOnglet = wsParam.Range("E4").Value

' Suppression des doublons dans l'ensemble de l'onglet
Set wsCible = ThisWorkbook.Sheets(nomOnglet)
.UsedRange.RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26), Header:=xlNo
End With

' Confirmation de la suppression des doublons
MsgBox "Les doublons ont été supprimés dans l'onglet '" & nomOnglet & "'.", vbInformation
End Sub

- Mais ça ne fonctionne pas...

Avez-vous une idée ?

15test.zip (89.54 Ko)

merci beaucoup !

Seb

Le 13/02/2024 à 20:02

Bonsoir,

Essayez ceci:

Sub SupprimerDoublons()
    Dim wsParam As Worksheet
    Dim wsCible As Worksheet
    Dim nomOnglet As String
    Dim i As Integer, j As Long, DerCol As Integer, DerLig As Long
    Application.ScreenUpdating = False

    ' Référence à l'onglet "Paramètres"
    Set wsParam = ThisWorkbook.Sheets("Paramètres")

    ' Lecture du nom de l'onglet cible depuis la cellule E4 de l'onglet "Paramètres"
    nomOnglet = wsParam.Range("E4").Value

    'Ajout d'une concaténation des valeurs en colonne A
    Set wsCible = ThisWorkbook.Sheets(nomOnglet)
    wsCible.Select
    DerLig = wsCible.Range("A" & Rows.Count).End(xlUp).Row
    DerCol = wsCible.Range("A1").End(xlToRight).Column + 1
    wsCible.Columns("A:A").Insert Shift:=xlToRight
    For j = 2 To DerLig
        For i = 2 To DerCol
Concatener:
            On Error Resume Next
            Concat = Concat & "; " & wsCible.Cells(j, i)
            If Err.Number <> 0 Then
                On Error GoTo 0
                wsCible.Cells(j, i) = " "
                GoTo Concatener
            End If
        Next i
        wsCible.Cells(j, "A") = Concat
        Concat = ""
    Next j

    'Suppression des doublons
    For i = DerLig To 2 Step -1
        If Application.WorksheetFunction.CountIf(Range("A2:A" & i), Cells(i, "A")) > 1 Then Rows(i).Delete
    Next i

    ' Confirmation de la suppression des doublons
    MsgBox "Les doublons ont été supprimés dans l'onglet '" & nomOnglet & "'.", vbInformation

    'Suppression de la colonne A
    Columns("A:A").Delete Shift:=xlToLeft
End Sub

Cdlt

Ps: si ça vous convient, passez en résolu

Le 14/02/2024 à 12:17

Bonjour Arturo,

merci beaucoup pour votre aide !
J'ai repris le script tel quel en incluant mes données mais ça ne fonctionne pas. Le résultat n'est pas celui escompté.

Ca me supprime tout et me donne une erreur sur .UsedRange.RemoveDuplicates Columns:=Array(i), Header:=xlNo

14test.xlsm (113.79 Ko)
Le 14/02/2024 à 13:01

Bonjour

Correctif

Sub SupprimerDoublons()
    Dim wsParam As Worksheet
    Dim wsCible As Worksheet
    Dim nomOnglet As String
    Dim i As Integer, DerCol As Integer
    Application.ScreenUpdating = False

    ' Référence à l'onglet "Paramètres"
    Set wsParam = ThisWorkbook.Sheets("Paramètres")

    ' Lecture du nom de l'onglet cible depuis la cellule E4 de l'onglet "Paramètres"
    nomOnglet = wsParam.Range("E4").Value

    ' Suppression des doublons dans l'ensemble de l'onglet
    Set wsCible = ThisWorkbook.Sheets(nomOnglet)
    DerCol = wsCible.Range("A1").End(xlToRight).Column
    With wsCible
        For i = 1 To DerCol
            DerLig = .Cells(1, i).End(xlDown).Row
            .Range(Cells(1, i), Cells(DerLig, i)).RemoveDuplicates Columns:=1, Header:=xlYes
        Next i
    End With

    ' Confirmation de la suppression des doublons
    MsgBox "Les doublons ont été supprimés dans l'onglet '" & nomOnglet & "'.", vbInformation
End Sub

Cdlt

Le 14/02/2024 à 14:50

j'ai toujours un problème sur :
.Range(Cells(1, i), Cells(DerLig, i)).RemoveDuplicates Columns:=1, Header:=xlYes

Method Range of Object _Worksheet failed

17test.xlsm (117.15 Ko)
Le 14/02/2024 à 18:52

Ajoutez la ligne en bleu

Sub SupprimerDoublons()
Dim wsParam As Worksheet
Dim wsCible As Worksheet
Dim nomOnglet As String
Dim i As Integer, DerCol As Integer
Application.ScreenUpdating = False

' Référence à l'onglet "Paramètres"
Set wsParam = ThisWorkbook.Sheets("Paramètres")

' Lecture du nom de l'onglet cible depuis la cellule E4 de l'onglet "Paramètres"
nomOnglet = wsParam.Range("E4").Value

' Suppression des doublons dans l'ensemble de l'onglet
Set wsCible = ThisWorkbook.Sheets(nomOnglet)
wsCible.Select '************************************************************************
DerCol = wsCible.Range("A1").End(xlToRight).Column
With wsCible
For i = 1 To DerCol
DerLig = .Cells(1, i).End(xlDown).Row
Range(Cells(1, i), Cells(DerLig, i)).RemoveDuplicates Columns:=1, Header:=xlYes
Next i
End With

' Confirmation de la suppression des doublons
MsgBox "Les doublons ont été supprimés dans l'onglet '" & nomOnglet & "'.", vbInformation
End Sub

Le 15/02/2024 à 09:47

Le code tourne désormais mais la macro supprime les doublons de chaque colonne individuellement et non de la ligne complète

Le 15/02/2024 à 13:23

Oui mais, votre demande n'était pas très explicite

Essayez celle-ci:

Sub SupprimerDoublons()
    Dim wsParam As Worksheet
    Dim wsCible As Worksheet
    Dim nomOnglet As String
    Dim i As Integer, j As Long, DerCol As Integer, DerLig As Long
    Application.ScreenUpdating = False

    ' Référence à l'onglet "Paramètres"
    Set wsParam = ThisWorkbook.Sheets("Paramètres")

    ' Lecture du nom de l'onglet cible depuis la cellule E4 de l'onglet "Paramètres"
    nomOnglet = wsParam.Range("E4").Value

    'Ajout d'une concaténation des valeurs en colonne A
    Set wsCible = ThisWorkbook.Sheets(nomOnglet)
    wsCible.Select
    DerLig = wsCible.Range("A" & Rows.Count).End(xlUp).Row
    DerCol = wsCible.Range("A1").End(xlToRight).Column + 1
    wsCible.Columns("A:A").Insert Shift:=xlToRight
    For j = 2 To DerLig
        For i = 2 To DerCol
Concatener:
            On Error Resume Next
            Concat = Concat & "; " & wsCible.Cells(j, i)
            If Err.Number <> 0 Then
                On Error GoTo 0
                wsCible.Cells(j, i) = " "
                GoTo Concatener
            End If
        Next i
        wsCible.Cells(j, "A") = Concat
        Concat = ""
    Next j

    ' Suppression des doublons dans l'ensemble de l'onglet
    With wsCible.Range(Cells(1, "A"), Cells(DerLig, "A"))
        .RemoveDuplicates Columns:=DerCol, Header:=xlYes
    End With

    ' Confirmation de la suppression des doublons
    MsgBox "Les doublons ont été supprimés dans l'onglet '" & nomOnglet & "'.", vbInformation

    'Suppression de la colonne A
    Columns("A:A").Delete Shift:=xlToLeft
End Sub
Rechercher des sujets similaires à "macro supprimer doublon"