Discussion :

[Sophiie]

Salut à tous,

J’ai 2 petits cas à traiter pour une application, et je ne serais pas contre un petit coup de main.

1er cas : suppression de lignes « dupliquées » (parfois 2, 3,4, …). J’ai un script mais il est très lent car je crois qu’il vérifie le contenu de chaque cellule sur toute la ligne. Comme dans mon exemple, je souhaiterais que la vérification des doublons ne se fasse que sur le contenu d’une seule colonne (la B). Puis suppression des lignes toutes entières qui on était dupliquées, et on ressert les lignes pour éviter les espaces vides.

Voilà ce que j'utilisais jusqu’à présent, mais le script vérifie le contenu de chaque cellule, ce qui rend le traitement monstrueusement long :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
Sub SuppressionDoublons()
    Dim i as long, j as long, z as long
    Dim NomFeuille as String
    Dim LigPrem as long
    Dim lOriginal(0 to 4) as variant
    dim lIdentique as Boolean
    Dim lToControl as range
 
    Dim lMaxLine as long
    lMaxLine=Sheets(NomFeuille).Range("A" & "65536").End(xlup).row
 
    LigPrem = 2
    NomFeuille="Spécifiques sur BPR standard"
 
    For i = LigPrem to lmaxLine
        'Mise en tampon de la ligne à controler et controle de non vide (risque de bouclage infini sinon)
        lIdentique=true
        for z=0 to 4
            lOriginal(z)=sheets(NomFeuille).Range("A" & i).offset(0, z).value
            if lOriginal(z)<>"" then lIdentique=false
        next z
        if not lIdentique then
            For j= i +1 to lmaxLine+1
 
                if j< i +1 then j= i +1
 
                set lToControl=sheets(NomFeuille).Range("A" & j)
                lIdentique=True
                for z=0 to 4
                    if lOriginal(z)<>lToControl.Offset(0,z).value then
                        lIdentique=false
                        exit for
                    end if
                next z
                if lIdentique then
                    Rows(j).Delete
                    j=j-2
                end if
            Next j
        end if
    Next i
End Sub

2ème cas : Lorsque la valeur « oui » apparait dans la colonne 2, alors la ligne contenant la valeur « oui » écrase et remplace la ligne située juste au dessus d’elle (là encore on ressert les lignes pour pas qu’il n’y est d’espace vide.

J’espère ne pas trop vous en demandez, ma faible expérience de développeuse en herbe ne me permet pas de rédiger des scripts intelligibles et efficace.

Par avance merci.
Sophie

[mercatog]

Codes à adapter
1.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
Sub SuprDoublons()
Dim Nb As Integer, i As Integer
 
Application.ScreenUpdating = False
With Worksheets("Feuil1")
    Nb = .Range("A3").End(xlDown).Row
    For i = Nb To 4 Step -1
        If Application.CountIf(.Range("B4:B" & i), .Range("B" & i)) > 1 Then .Rows(i).Delete
    Next i
End With
End Sub

2.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Sub RemplaceOui()
Dim Nb As Integer, i As Integer
 
Application.ScreenUpdating = False
With Worksheets("Feuil1")
    Nb = .Range("A19").End(xlDown).Row
    i = Nb
    Do
        If .Range("B" & i) = "oui" Then
            .Rows(i).Cut .Range("A" & i - 1)
            .Rows(i).Delete
            i = i - 1
        End If
        i = i - 1
    Loop While i > 20
End With
End Sub

[Daniel.C]

Bonsoir,

Essaie ces deux macros :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Sub SupprDoublons()
    Dim Plage As Range
    With Sheets("Feuil1")
        .AutoFilterMode = False
        Set Plage = .Range(.[A3], .Cells(.Rows.Count, 1).End(xlUp)).Resize(, 7)
        Plage.AutoFilter 7, 1
        Set Plage = .AutoFilter.Range.Offset(1).Resize(.AutoFilter.Range.Rows.Count - 1)
        If Application.Subtotal(103, Plage.Resize(, 1)) > 0 Then
            Application.DisplayAlerts = False
            Plage.SpecialCells(xlCellTypeVisible).Delete
            Application.DisplayAlerts = True
        End If
        .AutoFilterMode = False
    End With
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Sub EcraseLigne()
    With Sheets("Feuil1")
    For i = .Cells(.Rows.Count, 2).End(xlUp).Row To 1 Step -1
        If .Cells(i, 2) = "non" And .Cells(i + 1, 2) = "oui" Then
            .Cells(i, 2) = "***"
        End If
    Next i
    For i = .Cells(.Rows.Count, 2).End(xlUp).Row To 1 Step -1
        If .Cells(i, 2) = "***" Then
            Application.DisplayAlerts = False
            .Cells(i, 2).EntireRow.Delete
            Application.DisplayAlerts = True
        End If
    Next i
    End With
End Sub

[Sophiie]

Hello à vous et merci bien d’avoir pris la peine de m’aider.
J’ai testé chacun de vos scripts, et j’avoue avoir quelques questions sur certains points.

Dans le code de Mercatog :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

For i = Nb To 4 Step -1

Le pas indique que l'on passe d'une valeur positive vers une valeur négative, donc on remonte du bas vers le haut si je comprends bien, mais pourquoi avoir choisi "4" comme grandeur ?Est ce un raisonnement sur l'étendu de l'intervalle à traiter ? ici 5, sous entendant il faut traiter 5 lignes par 5 lignes ?

Dans le code de Daniel :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
    Set Plage = .Range(.[A3], .Cells(.Rows.Count, 1).End(xlUp)).Resize(, 7)
        Plage.AutoFilter 7, 1

Je ne parviens pas à faire tourner ce code pour supprimer les lignes entières contenant des doublons dans une colonne bien particulière. Ici je ne comprend pas pourquoi on redimensionne une colonne, puis l'usage du filtre juste derrière.

Les 3 autres code fonctionnent remarquablement bien. Je vous remercie trés sincèrement pour ce coup de main bien appuyé.
Sophie.

[mercatog]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

For i = Nb To 4 Step -1

on parcours notre feuille de la dernière ligne remplie du tableau jusqu'à la ligne 4 avec un pas de -1 ligne, cad on remonte) Nb, puis Nb-1...jusqu'à la ligne 4

Bien sûr les code proposé été testé sur le fichier que tu as joins. A toi de comprendre et d'adapter à ton véritable fichier.

Code commenté

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Sub SuprDoublons()
Dim Nb As Integer, i As Integer
 
Application.ScreenUpdating = False
With Worksheets("Feuil1")
    'N° de la dernière cellule remplie de la colonne A de ton tableau
    Nb = .Range("A3").End(xlDown).Row
    'on parcours les lignes de la dernière ligne remplie jusqu'à la ligne 4 (en remontant)
    For i = Nb To 4 Step -1
        'Si le nombre de valeurs de Bi >1 (cad doublon) on supprime la ligne i
        'CountIf c'est l'équivalent de la fonction excel NBVAL
        If Application.CountIf(.Range("B4:B" & i), .Range("B" & i)) > 1 Then .Rows(i).Delete
        'on passe à la ligne i-1...etc
    Next i
End With
End Sub

[Daniel.C]

Bonjour,

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
Set Plage = .Range(.[A3], .Cells(.Rows.Count, 1).End(xlUp)).Resize(, 7)
        Plage.AutoFilter 7, 1

Ici je ne comprend pas pourquoi on redimensionne une colonne, puis l'usage du filtre juste derrière.

1. je dimensionne la plage occupée par les donnée de la colonne A puis j'étends la plage aux 7 colonnes de l'exemple.
2. Note que j'ai mis en G4 la formule :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

=SI(NB.SI($B$4:B4;B4)>1;1;0)

reproduite vers le bas. Elle indique "1" pour les doublons. Je filtre sur cette colonne popur supprimer les lignes filtrées.
Je joins le classeur avec lequel j'ai fait les tests.

[Sophiie]

Merci à vous pour vos efforts et la clarté de vos explications.
Sophie.