Supprimer Ligne avec comparaison

Bonjour,

Je souhaite supprimer des lignes en doublons en fonction de critères particuliers.

Voici mon code qui ne fonctionne pas :

Sub doubles_innov()

Dim i As Long

Application.ScreenUpdating = False

For i = 3000 To 1 Step -1

'je veux comparer la valeur de la cellule avec celle du dessus d'ou l (i-1), pour détecter un doublon

If Cells(i, 17) = Cells((i - 1), 17) Then

'Si doublon alors on supprime en fonction de critéres

If Cells(i, 9) = "N" Then

Rows(i).EntireRow.delete

Else

If Cells(i, 10) = "FRMRS" Then

Rows(i).EntireRow.delete

End If

End If

End If

Next

End Sub

Merci de m'indiquer si la marche à suivre est la bonne. J'avais fait deux boucles imbriquées mais cela fait ralentir considérablement la macro.

En vous remerciant

Cordialement

Bonjour nonesofar13,

Une première erreur détectée:

Tu fais ta boucle de i = 3000 à i = 1

Lorsque i = 1 -> i - 1 = 0 -> la cellule ligne 0 n'existe pas. Il faut donc écrire

For i = 3000 To 2 Step -1

Une deuxième erreur détectée: n'oublie pas de réafficher le résultat!

Application.ScreenUpdating = True

Sinon voilà ton code "corrigé" et indenté.

Sub doubles_innov()
Dim i As Long
Application.ScreenUpdating = False

For i = 3000 To 2 Step -1
'je veux comparer la valeur de la cellule avec celle du dessus d'ou l (i-1), pour détecter un doublon
    If Cells(i, 17) = Cells((i - 1), 17) Then
        'Si doublon alors on supprime en fonction de critéres 
        If Cells(i, 9) = "N" Then
            Rows(i).EntireRow.delete
        ElseIf Cells(i, 10) = "FRMRS" Then
            Rows(i).EntireRow.delete
        End If
    End If
Next i 
Application.ScreenUpdating = True
End Sub

Quand tu dis que ton code ne fonctionne pas, qu'es-ce qui ne fonctionne pas? La démarche est tout à fait correcte.

Merci d3d9x,

Alors j'ai testé ta correction, il fonctionne mais j'ai une ligne qui reste car elle se retrouve à ce comparer à la valeur (i - 1) qui correspond au titre de mon tableau. Cela a rien à voir donc le macro ne détecte pas de doublon , elle ne fait rien alors que cette ligne est bien un doublon.

Il faudrait que je compare à celle d'en dessous et la c'est plus compliqué.

Pour info j'ai fait une copie d'écran sur la ligne marron qui reste un doublon non supprimé.

Merci d'avance.

capture vba

C'est très étrange, peux-tu m'envoyer ton fichier uniquement avec la page concernant, juste les X premières lignes représentatives?

Je t'avoue que je ne comprend pas pourquoi la ligne n'est pas supprimée, sauf si le test n'est pas fait que sur le contenu.

Tu peux essayer de remplacer

If Cells(i, 17) = Cells((i - 1), 17) Then

par

If Cells(i, 17).Value = Cells((i - 1), 17).Value Then

Merci du code d3d9x, mais ça ne change rien.

j'ai envoyé en mp le fichier.

Merci d'avance.

Si d'autres membres veulent tester ce code .

Bonne journée à tous 8)

Voila j'ai résolu mon probléme.

Il fallait faire une loup de scan sur les valeurs en doublon et faire le test dessus, ça semble de bien marcher

Sub doubles_innov()
Dim i As Long
Dim cnt As String

Application.ScreenUpdating = False

For i = 3000 To 2 Step -1
'je veux comparer la valeur de la cellule avec celle du dessus d'ou l (i-1), pour détecter un doublon
        If Cells(i, 17) = Cells((i - 1), 17) Then

        cnt = Cells(i, 17)
                'Si doublon & scan avec loop + on supprime en fonction de critères
            Do Until Cells(i, 17) <> cnt

                If Cells(i, 9) = "condition" Then
                        Rows(i).EntireRow.Delete
                ElseIf Cells(i, 10) = "condition" Then
                        Rows(i).EntireRow.Delete
                End If
                    i = i - 1
            Loop
    End If

Next i
Application.ScreenUpdating = True
End Sub

j'ai besoin d'une confirmation dans ce que tu veux:

Tu retires une ligne si c'est un doublon ET la colonne 9 contient un "N" OU la colonne 17 contient "FRMRS"

j'ai besoin d'une confirmation dans ce que tu veux:

Tu retires une ligne si c'est un doublon ET la colonne 9 contient un "N" OU la colonne 10 contient "FRMRS"

Voilà une solution fonctionne, je te laisse la tester sur ton vrai fichier et revenir vers moi

Sub clearV2()
Dim rebalayer As Boolean, numLigne As Long, nbLignes As Long, i As Long

rebalayer = True

While rebalayer
    nbLignes = Cells(Rows.Count, "A").End(xlUp).Row
    rebalayer = False
    For numLigne = 2 To nbLignes
        For i = 2 To nbLignes
            If numLigne <> i Then
                If Cells(numLigne, 17) = Cells(i, 17) Then
                    If Cells(numLigne, 9) = "N" Or Cells(numLigne, 10) = "FRMRS" Then
                            Rows(numLigne).EntireRow.Delete
                            rebalayer = True
                            GoTo rebalayer
                    End If
                End If
            End If
        Next i
    Next numLigne
rebalayer:
Wend
End Sub

Merci d3d9x,

Je retires une ligne si c'est un doublon ET si la colonne 9 contient un "N" OU bien la colonne 10 contient "FRMRS".

Merci en effet mon code précédant ne traite pas tous les cas. Vais teste ta corraction

Bonjour,

Merci d3d9x , le code marche bien sur le petit portion que j'avais fourni pour le test.

Mais si j'exporte aux 1000 lignes que j'ai à faire, la macro plante et boucle sur elle-même .

Voila en pj ma liste, j'ai souhaité alléger le fichier du coup il est enregistré au format binaire.

En vous remerciant par avance.

Pour ma part la macro tourne sans problème et ne plante pas. j'ai mis un message à la fin de la procédure de check et tout se passe correctement, même si cela prend une dizaine de secondes.

Voilà avec une mini modification:

  • Une progression affichée en bas à gauche de ta fenêtre, pour savoir où en est la progression globale
  • Un message à la fin de la procédure

PS: chez moi la progression plante de temps en temps, mais dans tous les cas la procédure se termine.

Ok bizarre,

Je peux envoyer le fichier global sur lequel je teste, via google drive.

Onglet ou je teste la macro est "test_all a checker" en rouge.

En vous remerciant par avance.

Oui je vois, la solution que je t'ai proposé ne convient pas à cause du trop grand nombre de lignes.

J'essayerais de te proposer une alternative ce soir/dans la nuit, là je vais être occupé.

Cependant le code en lui même ne présente pas d'erreurs et ne plante pas, il est juste très long car mal pensé de ma part pour autant de lignes.

Oui je comprends en effet ce code fonctionne sur un petit échantillon.

Malheureusement il boucle sur lui même et ne dépasse pas les lignes 100 . Je pensais que j'allais trouver rapidement une solution que je suis toujours bloqué , les joies du code...

Merci de ton aide en tout cas

Code à tester:

Sub clearV3()
Dim rebalayer As Boolean, numLigne As Long, nbLignes As Long, i As Long
On Error GoTo erreur
rebalayer = True
Application.ScreenUpdating = False

While rebalayer
    nbLignes = Cells(Rows.Count, "A").End(xlUp).Row
    rebalayer = False
    For numLigne = 2 To nbLignes
        Application.StatusBar = True
        Application.StatusBar = "Recherche des doublons de la ligne " & numLigne & " sur " & nbLignes & " lignes."
        For i = nbLignes To numLigne Step -1
            If numLigne <> i Then
                If Cells(numLigne, 75) = Cells(i, 75) Then
                    If Cells(numLigne, 24) = "N" Or Cells(numLigne, 25) = "FRMRS" Then
                            Rows(numLigne).EntireRow.Delete
                            rebalayer = True
                    End If
                End If
            End If
        Next i
    Next numLigne
Wend
Application.StatusBar = False
Application.ScreenUpdating = True
MsgBox "terminé"
Exit Sub

erreur:
Debug.Print "Erreur"

End Sub

Ok merci,

je teste ça et te reviens.

bonne soirée.

Salut,

la dernière version ne marche malheureusement pas même sur la petite portion de test .

Je suis en train de debugger voir si je peux corriger.

Bonjour,

Help les copains

Si d'autres membres souhaitent m'aider lol, je suis un peu perdu depuis 3 jours sur ce code.

Je souhaite supprimer une ligne en doublon si elle répond à des critères déterminés dans deux autres colonne.

Alors le fichier fait 2000 lignes environ.

la règle est :

test de la colonne 75.

  • si doublon on supprime la ligne avec N dans une colonne 24.
  • si doublon on supprime la ligne avec FRMRS dans la colonne 25.

Macro qui fonctionne bien sur 50 lignes sauf que lorsqu'on le lance sur les 2000 elle plante.

Je ne comprend pas trop pourquoi, sauf qu'elle ne tient pas un grand nombre de ligne

A noter le numéro de colonne change par rapport à l'énoncé, mais c’était juste pour le test.

Sub clearV2()
Dim rebalayer As Boolean, numLigne As Long, nbLignes As Long, i As Long

rebalayer = True

While rebalayer
    nbLignes = Cells(Rows.Count, "A").End(xlUp).Row
    rebalayer = False
    For numLigne = 2 To nbLignes
        For i = 2 To nbLignes
            If numLigne <> i Then
                If Cells(numLigne, 17) = Cells(i, 17) Then
                    If Cells(numLigne, 9) = "N" Or Cells(numLigne, 10) = "FRMRS" Then
                            Rows(numLigne).EntireRow.Delete
                            rebalayer = True
                            GoTo rebalayer
                    End If
                End If
            End If
        Next i
    Next numLigne
rebalayer:
Wend
End Sub

Merci d'avance si vous avez des proposition.

le fichier exemple : Pour tester sur le nombre total prendre l'onglet "test_all a checker" onglet en rouge.

Merci d'avance,

Bonne journée.

Sub clearV4()
Dim rebalayer As Boolean, numLigne As Long, nbLignes As Long, i As Long, nbDoublons As Long

nbDoublons = 0

rebalayer = True
Application.ScreenUpdating = False
Application.StatusBar = True

numLigne = 2

recommencer:

While numLigne < Cells(Rows.Count, "A").End(xlUp).Row  'on boucle tant qu'on a qqlchose dans la cellule colonne A

    nbLignes = Cells(Rows.Count, "A").End(xlUp).Row 'on récupère le nombre de lignes
    'Debug.Print nbLignes & " lignes"
    If Cells(numLigne, 1) = "" Or Cells(numLigne, 75) = "" Then
        'On fait rien
        'Debug.Print "Ligne " & numLigne & " vide"
    Else
        For i = nbLignes To numLigne Step -1 'on remonte dans les lignes jusqu'à attendre la ligne "testée"
            If numLigne <> i Then 'on ne teste pas une ligne avec elle-même
                If Cells(numLigne, 75) = Cells(i, 75) Then
                        If Cells(i, 24) = "N" Or Cells(i, 25) = "FRMRS" Then 'cas cool, la ligne à supprimer est la ligne du dessous
                            Rows(i).EntireRow.Delete
                            nbDoublons = nbDoublons + 1
                        ElseIf Cells(numLigne, 24) = "N" Or Cells(numLigne, 25) = "FRMRS" Then 'cas moins cool, la ligne à supprimer est la ligne du dessus
                            Rows(numLigne).EntireRow.Delete
                            nbDoublons = nbDoublons + 1
                            GoTo recommencer: 'on recommence donc tout
                        End If
                End If
            End If
        Next i
    End If
    numLigne = numLigne + 1
    Application.StatusBar = "Traitement ligne " & numLigne

Wend
Application.ScreenUpdating = False
Application.StatusBar = False

Debug.Print nbDoublons

End Sub

Désolé je m'améliore à chaque jet ^^ 233 doublons, exécuté en quelques secondes

Rechercher des sujets similaires à "supprimer ligne comparaison"