Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11
Entraide Applications Microsoft Office Excel Supression des lignes en double

Supression des lignes en double

24 réponses
Avatar
romeo59181
Ce message est composé et au format MIME.

------=_NextPart_000_00BA_01C8F25E.37B956C0
Content-Type: text/plain;
charset="iso-8859-1"
Content-Transfer-Encoding: quoted-printable

Bonjour,=20

Tout est dans le titre ...

Je recherche une macro qui me supprimeras toutes les lignes 100% =
identiques,

@+

Romeo59181
------=_NextPart_000_00BA_01C8F25E.37B956C0
Content-Type: text/html;
charset="iso-8859-1"
Content-Transfer-Encoding: quoted-printable

<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
<HTML><HEAD>
<META http-equiv=3DContent-Type =
content=3Dtext/html;charset=3Diso-8859-1>
<META content=3D"MSHTML 6.00.6000.16681" name=3DGENERATOR></HEAD>
<BODY id=3DMailContainerBody=20
style=3D"PADDING-RIGHT: 10px; PADDING-LEFT: 10px; PADDING-TOP: 15px"=20
bgColor=3D#ffffff leftMargin=3D0 topMargin=3D0 CanvasTabStop=3D"true"=20
name=3D"Compose message area">
<DIV><FONT face=3DArial size=3D2>Bonjour, </FONT></DIV>
<DIV><FONT face=3DArial size=3D2></FONT>&nbsp;</DIV>
<DIV><FONT face=3DArial size=3D2>Tout est dans le titre ...</FONT></DIV>
<DIV><FONT face=3DArial size=3D2></FONT>&nbsp;</DIV>
<DIV><FONT face=3DArial size=3D2>Je recherche une macro qui me =
supprimeras toutes=20
les lignes 100% identiques,</FONT></DIV>
<DIV><FONT face=3DArial size=3D2></FONT>&nbsp;</DIV>
<DIV><FONT face=3DArial size=3D2>@+</FONT></DIV>
<DIV><FONT face=3DArial size=3D2></FONT>&nbsp;</DIV>
<DIV><FONT face=3DArial size=3D2>Romeo59181</FONT></DIV></BODY></HTML>

------=_NextPart_000_00BA_01C8F25E.37B956C0--
Signaler un problème avec ce contenu

4 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
1 2 3
Avatar
romeo59181
Bonjour,

Un GRAND merci à toi pour le temps passer à résoudre mes demandes ...

Une petite dernière,

Comment mettre les 2 macros ensemble ?

Celle du classement de lignes et celle qui supprime les doublons,

@+

Romeo59181

Ps : Petite confirmation au passage la suppression de doublon contrôle bien
les colonnes b & c ?

"FFO" a écrit dans le message de groupe de
discussion :
Rebonjour à toi

Pour la suppression des lignes en double ce code modifié est plus rapide
que
celui que je t'ai proposé :

Range("A2", "A" &
Range("A2").SpecialCells(xlCellTypeLastCell).Row).EntireRow.Sort
Key1:=Range("A2"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("A" & Range("A2").SpecialCells(xlCellTypeLastCell).Row).Activate
Do While ActiveCell.Offset(-i, 0).Row > 1
For j = 1 To Range("A1").SpecialCells(xlCellTypeLastCell).Column
If Cells(ActiveCell.Offset(-i, 0).Row, j) <> Cells(ActiveCell.Offset(-i,
0).Row - 1, j) Then
Divergence = 1
Exit For
End If
Next
If Divergence <> 1 Then
ActiveCell.Offset(-i, 0).EntireRow.Clear
End If
Divergence = ""
i = i + 1
Loop
Range("A2", "A" &
Range("A2").SpecialCells(xlCellTypeLastCell).Row).EntireRow.Sort
Key1:=Range("A2"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("A1").Activate

Essayes le et dis moi !!!!


Avatar
FFO
Rebonjour romero

Enfin content que tu sois satisfait

Pour faire fonctionner les 2 codes ensembles tu peux soit les mettre l'un
aprés l'autre dans chaque Macro traitant les couleurs soit mettre le code
traitant les doublons dans une nouvelle Macro ("Doublon") que tu appelleras à
la fin de chaque code traitant les couleurs en mettant la ligne :

Run("Doublon")

Attention si le code traitant des couleurs fonctionne en l'état celui des
doublons a besoin au préalable d'avoir l'onglet à traiter actif

Je ne sait pas si tous les Onglets comme pour les couleurs ont besoin d'être
traité mais par onglet à traiter il faudra mettre :

Sheets("Onglet à traiter").Activate
Par exemple pour l'Onglet "Général" il faut mettre :
Sheets("Général").Activate
Puis le code Doublon

Renouveler l'opération pour chaque Onglet concerné

L'ensemble de tout ces codes peuvent être mis l'un aprés l'autre dans une
Macro

Mais si tous les Onglets sont à traiter je te préconise plustôt ce seul et
unique code :

For k = 1 to Sheets.Count
Sheets(k).Activate
Range("A2", "A" &
Range("A2").SpecialCells(xlCellTypeLastCell).Row).EntireRow.Sort
Key1:=Range("A2"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("A" & Range("A2").SpecialCells(xlCellTypeLastCell).Row).Activate
Do While ActiveCell.Offset(-i, 0).Row > 1
For j = 1 To Range("A1").SpecialCells(xlCellTypeLastCell).Column
If Cells(ActiveCell.Offset(-i, 0).Row, j) <> Cells(ActiveCell.Offset(-i,
0).Row - 1, j) Then
Divergence = 1
Exit For
End If
Next
If Divergence <> 1 Then
ActiveCell.Offset(-i, 0).EntireRow.Clear
End If
Divergence = ""
i = i + 1
Loop
Range("A2", "A" &
Range("A2").SpecialCells(xlCellTypeLastCell).Row).EntireRow.Sort
Key1:=Range("A2"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("A1").Activate
Next

Si un onglet n'est pas à traiter tu peux mettre le code ci-dessus modifié
ainsi :

For k = 1 to Sheets.Count
If Sheets(k).Name <> "Nom de l'onglet à ne pas traiter"
Sheets(k).Activate
Range("A2", "A" &
Range("A2").SpecialCells(xlCellTypeLastCell).Row).EntireRow.Sort
Key1:=Range("A2"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("A" & Range("A2").SpecialCells(xlCellTypeLastCell).Row).Activate
Do While ActiveCell.Offset(-i, 0).Row > 1
For j = 1 To Range("A1").SpecialCells(xlCellTypeLastCell).Column
If Cells(ActiveCell.Offset(-i, 0).Row, j) <> Cells(ActiveCell.Offset(-i,
0).Row - 1, j) Then
Divergence = 1
Exit For
End If
Next
If Divergence <> 1 Then
ActiveCell.Offset(-i, 0).EntireRow.Clear
End If
Divergence = ""
i = i + 1
Loop
Range("A2", "A" &
Range("A2").SpecialCells(xlCellTypeLastCell).Row).EntireRow.Sort
Key1:=Range("A2"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("A1").Activate
End If
Next


Le tout mis dans une seule Macro appelé "Doublon" que tu appellera à la fin
de toutes tes Macros couleurs par la ligne :

Run("Doublon")

Espérant ne pas t'avoir noyé et répondu une fois de plus à ton attente

Dis moi !!!!
Avatar
romeo59181
Bonjour,

Là j'avoue je suis noyé ...

lol

Les doublons sont à contrôler sur tous les onglets sur la colonne b & c ...
( Car la A est purement décorative )

@+

Romeo59181

"FFO" a écrit dans le message de groupe de
discussion :
Rebonjour romero

Enfin content que tu sois satisfait

Pour faire fonctionner les 2 codes ensembles tu peux soit les mettre l'un
aprés l'autre dans chaque Macro traitant les couleurs soit mettre le code
traitant les doublons dans une nouvelle Macro ("Doublon") que tu
appelleras à
la fin de chaque code traitant les couleurs en mettant la ligne :

Run("Doublon")

Attention si le code traitant des couleurs fonctionne en l'état celui des
doublons a besoin au préalable d'avoir l'onglet à traiter actif

Je ne sait pas si tous les Onglets comme pour les couleurs ont besoin
d'être
traité mais par onglet à traiter il faudra mettre :

Sheets("Onglet à traiter").Activate
Par exemple pour l'Onglet "Général" il faut mettre :
Sheets("Général").Activate
Puis le code Doublon

Renouveler l'opération pour chaque Onglet concerné

L'ensemble de tout ces codes peuvent être mis l'un aprés l'autre dans une
Macro

Mais si tous les Onglets sont à traiter je te préconise plustôt ce seul et
unique code :

For k = 1 to Sheets.Count
Sheets(k).Activate
Range("A2", "A" &
Range("A2").SpecialCells(xlCellTypeLastCell).Row).EntireRow.Sort
Key1:=Range("A2"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("A" & Range("A2").SpecialCells(xlCellTypeLastCell).Row).Activate
Do While ActiveCell.Offset(-i, 0).Row > 1
For j = 1 To Range("A1").SpecialCells(xlCellTypeLastCell).Column
If Cells(ActiveCell.Offset(-i, 0).Row, j) <> Cells(ActiveCell.Offset(-i,
0).Row - 1, j) Then
Divergence = 1
Exit For
End If
Next
If Divergence <> 1 Then
ActiveCell.Offset(-i, 0).EntireRow.Clear
End If
Divergence = ""
i = i + 1
Loop
Range("A2", "A" &
Range("A2").SpecialCells(xlCellTypeLastCell).Row).EntireRow.Sort
Key1:=Range("A2"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("A1").Activate
Next

Si un onglet n'est pas à traiter tu peux mettre le code ci-dessus modifié
ainsi :

For k = 1 to Sheets.Count
If Sheets(k).Name <> "Nom de l'onglet à ne pas traiter"
Sheets(k).Activate
Range("A2", "A" &
Range("A2").SpecialCells(xlCellTypeLastCell).Row).EntireRow.Sort
Key1:=Range("A2"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("A" & Range("A2").SpecialCells(xlCellTypeLastCell).Row).Activate
Do While ActiveCell.Offset(-i, 0).Row > 1
For j = 1 To Range("A1").SpecialCells(xlCellTypeLastCell).Column
If Cells(ActiveCell.Offset(-i, 0).Row, j) <> Cells(ActiveCell.Offset(-i,
0).Row - 1, j) Then
Divergence = 1
Exit For
End If
Next
If Divergence <> 1 Then
ActiveCell.Offset(-i, 0).EntireRow.Clear
End If
Divergence = ""
i = i + 1
Loop
Range("A2", "A" &
Range("A2").SpecialCells(xlCellTypeLastCell).Row).EntireRow.Sort
Key1:=Range("A2"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("A1").Activate
End If
Next


Le tout mis dans une seule Macro appelé "Doublon" que tu appellera à la
fin
de toutes tes Macros couleurs par la ligne :

Run("Doublon")

Espérant ne pas t'avoir noyé et répondu une fois de plus à ton attente

Dis moi !!!!


Avatar
FFO
Rebonjours à toi

Si tous les onglets sont à traiter
Dans une nouvelle Macro appelé "Doublon" mets ce code :


For k = 1 To Sheets.Count
Sheets(k).Activate
Range("A2", "A" &
Range("A2").SpecialCells(xlCellTypeLastCell).Row).EntireRow.Sort
Key1:=Range("B2"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("A" & Range("A2").SpecialCells(xlCellTypeLastCell).Row).Activate
Do While ActiveCell.Offset(-i, 0).Row > 1
For j = 1 To Range("A1").SpecialCells(xlCellTypeLastCell).Column
If Cells(ActiveCell.Offset(-i, 0).Row, j) <> Cells(ActiveCell.Offset(-i,
0).Row - 1, j) Then
Divergence = 1
Exit For
End If
Next
If Divergence <> 1 Then
ActiveCell.Offset(-i, 0).EntireRow.Clear
End If
Divergence = ""
i = i + 1
Loop
Range("A2", "A" &
Range("A2").SpecialCells(xlCellTypeLastCell).Row).EntireRow.Sort
Key1:=Range("B2"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("A1").Activate
i = 0
Next

A la fin de chaque Macro de chaque Onglet traitant la répartition des lignes
en fonction de leur couleur tu mets cette ligne :

Run("Doublon")

A chaque Macro d'Onglet les couleurs seront réparties et les doublons de
tous les onglets seront supprimées grace à cette nouvelle Macro "Doublon"
appelée en fin de la procédure

Sur ce lien ton document adapté ainsi

http://www.cijoint.fr/cjlink.php?file=cj200808/cijcNriIpp.xls

Fais des essais et dis moi !!!!

Une petite imperfection à la suppression des doublons
En fait lorsqu'il y a doublon je vide la ligne du doublon puis en fin
d'analyse je retrie toutes les données restantes de l'onglet pour les
regrouper
Le hic c'est que le format des lignes des données restantes ne suit pas donc
tu as un Onglet sans doublon mais avec aprés les données regroupées un
certain nombre de lignes avec du quadrillage

Est ce un problème pour toi ????
Dis moi !!!!
1 2 3