Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11

supprimer doublons avec condition

12 réponses
Avatar
j
Bonjour,

J'ai plusieurs données sur des lignes dont certaines ont la meme valeur dans
une colonne.
je souhaiterai n'en conserver qu'une seule avec comme critère la dernière
date/heure définie dans une autre colonne.
En voici un exemple simplifié

Données d'Entrées en feuille (IN)

A B
Ligne1 : 800 10/1 08:00
Ligne2 : 800 10/1 07:00
Ligne3 : 800 11/1 04:00
Ligne4 : 850 8/1 12:00
Ligne5 : 850 9/1 16:00
Ligne6 : 900 10/1 12:00
Ligne7 : 900 10/1 13:00
Ligne8: 900 10/1 9:00
Ligne9: 930 12/1 04:00
Ligne10 : 999 12/1 9:00


Résultat Souhaité sur une autre feuille (OUT)

A B
Ligne1 : 800 11/1 04:00
Ligne2 : 850 9/1 16:00
Ligne3 : 900 10/1 13:00
Ligne4 : 930 12/1 04:00
Ligne5 : 999 12/1 9:00


En fait il doit y avoir une valeur unique en A avec la dernière date heure
(le fichier comporte environ 500 lignes)

Grand merci par avance

2 réponses

1 2
Avatar
j
Merci
Vraiement très sympa
je vais tester cela dès demain

bonne soirée


"isabelle" a écrit dans le message de news:
igpn2d$vn2$

Si possible, transmettre à sur le fil
"Supprimer doublons avec condition"

Ma connexion est en panne !

La procédure initiale éliminait les doublons à
partir du champ date voilà pourquoi elle ne
trouvait pas de doublons.

'--------------------------------------------
Sub test()
Dim DerLig As Long, Rg As Range
Dim ModCalcul As String
ModCalcul = Application.Calculation
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
'Application.ScreenUpdating = False
With Feuil1
DerLig = .Range("A:C").Cells.Find(What:="*", _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
Set Rg = .Range("A1:C" & DerLig)
End With

'En colonne D, Numérotation des lignes pour
'conserver l'ordre initial des données
Rg.Offset(, Rg.Columns.Count).Resize(, 1).Formula = _

"=row()"

'Trier les données sur le champ date en ordre décroissant

'Le champ 3 est supposé contenir les dates dans tableau
Rg.Sort Key1:=Rg.Columns(3), order1:=xlDescending, _

Header:=xlYes

'Application du filtre élaboré
ss = Rg.Columns(1).Address
Rg.Columns(1).AdvancedFilter Action:=xlFilterInPlace, _

Unique:=True

'Copie de la plage filtré vers la feuille Sheet2
Rg.SpecialCells(xlCellTypeVisible).Copy Feuil2.Range("A1")

On Error Resume Next
'enlever le filtre de la feuille "Sheet1"
Feuil1.ShowAllData

'Remettre le tableau source comme au début
'trier sur le tableau sur la colonne ajoutée
Rg.Offset(, Rg.Columns.Count).Resize(, 1).Sort _
Key1:=1, order1:=xlAscending, Header:=xlYes

'Si tu veux tes dates en ordre croissant dans la
'feuille de résultat
With Feuil2.Range("A1")
With .CurrentRegion
.Sort Key1:=.Columns(1), order1:=xlAscending, _

Header:=xlYes
End With
End With

'Nettoyer la colonne ajoutée
Rg.Offset(, Rg.Columns.Count).Resize(, 1).Clear

Application.Calculation = ModCalcul
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
'--------------------------------------------

MichD
--------------------------------------------


Le 2011-01-14 07:15, a écrit :
Bonjour,

Pas compris car les données dans la feuille source (IN) sont bien en
double
pour certaines dans la colonne A (800 et 801)
La feuille (OUT EX) étant le résultat attendu après traitement par la
macro.

Le principe étant de récuper la ligne qui a la date la plus proche
lorsqu'il
y a des valeurs identiques en A
Si il n'y a qu'une valeur on prend tout simplement

On pourrait aussi imaginer detruire toutes les lignes qui sont antérieur
a
la derniere date lorsque la valeur en A est identique

J'espère avoir été plus claire

Merci
Bonne journée


"michdenis" a écrit dans le message de news:
igpbgj$5im$

Dans ta feuille source, tu étais censé avoir des doublons.
Dans l'exemple de ton classeur, tu n'as aucun doublon.

Résultat cette ligne de code plante, car elle ordonne l'affichage
de toutes les données du filtre et comme il n'y a aucune ligne
masquée par le filtre, elle n'aime pas ça !

Voici la ligne de code :
Feuil1.ShowAllData

Le remède : avant celle-ci, insère :
On Error Resume Next

Tu peux effacer cette ligne de code de la procédure, c'était
seulement un point de repère pour moi durant l'écriture de
la procédure :
ss = Rg.Columns(3).Address

MichD
--------------------------------------------
"" a écrit dans le message de groupe de discussion :
4d2f7490$0$18329$

Bonsoir

J'ai testé mais ça plante
J'ai pourtant modifié de sheet vers feuil

Pour mieux me faire comprendre je joins un fichier exemple.
En feuil1(IN) les données d'entrées
En feuil2(OUT) les données souhaitées

Voici le lien

http://cjoint.com/?0bnwWAQgqjk

Merci


"michdenis" a écrit dans le message de news:
igkv10$dbl$
Bonjour,

Essaie ceci :

Les données sont en Sheet1 , colonne A, B, C.
Les dates sont en colonne C

Le résultat est copie en Sheet2 , débutant en A1

à toi d'adapter le nom des feuilles et des plages de cellules
dans ton application.

'----------------------------------------
Sub test()
Dim DerLig As Long, Rg As Range
Dim ModCalcul As String
ModCalcul = Application.Calculation
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
'Application.ScreenUpdating = False
With Sheet1
DerLig = .Range("A:C").Cells.Find(What:="*", _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
Set Rg = .Range("A1:C"& DerLig)
End With

'En colonne D, Numérotation des lignes pour
'conserver l'ordre initial des données
Rg.Offset(, Rg.Columns.Count).Resize(, 1).Formula = "=row()"

'Trier les données sur le champ date en ordre décroissant

'Le champ 3 est supposé contenir les dates dans tableau
Rg.Sort Key1:=Rg.Columns(3), order1:=xlDescending, Header:=xlYes

'Application du filtre élaboré
ss = Rg.Columns(3).Address
Rg.Columns(3).AdvancedFilter Action:=xlFilterInPlace, Unique:=True

'Copie de la plage filtré vers la feuille Sheet2
Rg.SpecialCells(xlCellTypeVisible).Copy Sheet2.Range("A1")

'enlever le filtre de la feuille "Sheet1"
Sheet1.ShowAllData

'Remettre le tableau source comme au début
'trier sur le tableau sur la colonne ajoutée
Rg.Offset(, Rg.Columns.Count).Resize(, 1).Sort _
Key1:=1, order1:=xlAscending, Header:=xlYes

'Si tu veux tes dates en ordre croissant dans la
'feuille de résultat
With Sheet2.Range("A1")
With .CurrentRegion
.Sort Key1:=.Columns(3), order1:=xlAscending, Header:=xlYes
End With
End With

'Nettoyer la colonne ajoutée
Rg.Offset(, Rg.Columns.Count).Resize(, 1).Clear

Application.Calculation = ModCalcul
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
'----------------------------------------



MichD
--------------------------------------------
"" a écrit dans le message de groupe de discussion :
4d2da0f3$0$18329$

Bonjour,

J'ai plusieurs données sur des lignes dont certaines ont la meme valeur
dans
une colonne.
je souhaiterai n'en conserver qu'une seule avec comme critère la
dernière
date/heure définie dans une autre colonne.
En voici un exemple simplifié

Données d'Entrées en feuille (IN)

A B
Ligne1 : 800 10/1 08:00
Ligne2 : 800 10/1 07:00
Ligne3 : 800 11/1 04:00
Ligne4 : 850 8/1 12:00
Ligne5 : 850 9/1 16:00
Ligne6 : 900 10/1 12:00
Ligne7 : 900 10/1 13:00
Ligne8: 900 10/1 9:00
Ligne9: 930 12/1 04:00
Ligne10 : 999 12/1 9:00


Résultat Souhaité sur une autre feuille (OUT)

A B
Ligne1 : 800 11/1 04:00
Ligne2 : 850 9/1 16:00
Ligne3 : 900 10/1 13:00
Ligne4 : 930 12/1 04:00
Ligne5 : 999 12/1 9:00


En fait il doit y avoir une valeur unique en A avec la dernière date
heure
(le fichier comporte environ 500 lignes)

Grand merci par avance









Avatar
j
Bonsoir

Merci Michdenis, tu es trop fort, je confirme cela fonctionne tip top et
grace a tes commentaires j'ai pu la modifier pour l'adapter a mon
application

Bonne soirée

"" a écrit dans le message de news:
4d30d68d$0$25490$
Merci
Vraiement très sympa
je vais tester cela dès demain

bonne soirée


"isabelle" a écrit dans le message de news:
igpn2d$vn2$

Si possible, transmettre à sur le fil
"Supprimer doublons avec condition"

Ma connexion est en panne !

La procédure initiale éliminait les doublons à
partir du champ date voilà pourquoi elle ne
trouvait pas de doublons.

'--------------------------------------------
Sub test()
Dim DerLig As Long, Rg As Range
Dim ModCalcul As String
ModCalcul = Application.Calculation
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
'Application.ScreenUpdating = False
With Feuil1
DerLig = .Range("A:C").Cells.Find(What:="*", _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
Set Rg = .Range("A1:C" & DerLig)
End With

'En colonne D, Numérotation des lignes pour
'conserver l'ordre initial des données
Rg.Offset(, Rg.Columns.Count).Resize(, 1).Formula = _

"=row()"

'Trier les données sur le champ date en ordre décroissant

'Le champ 3 est supposé contenir les dates dans tableau
Rg.Sort Key1:=Rg.Columns(3), order1:=xlDescending, _

Header:=xlYes

'Application du filtre élaboré
ss = Rg.Columns(1).Address
Rg.Columns(1).AdvancedFilter Action:=xlFilterInPlace, _

Unique:=True

'Copie de la plage filtré vers la feuille Sheet2
Rg.SpecialCells(xlCellTypeVisible).Copy Feuil2.Range("A1")

On Error Resume Next
'enlever le filtre de la feuille "Sheet1"
Feuil1.ShowAllData

'Remettre le tableau source comme au début
'trier sur le tableau sur la colonne ajoutée
Rg.Offset(, Rg.Columns.Count).Resize(, 1).Sort _
Key1:=1, order1:=xlAscending, Header:=xlYes

'Si tu veux tes dates en ordre croissant dans la
'feuille de résultat
With Feuil2.Range("A1")
With .CurrentRegion
.Sort Key1:=.Columns(1), order1:=xlAscending, _

Header:=xlYes
End With
End With

'Nettoyer la colonne ajoutée
Rg.Offset(, Rg.Columns.Count).Resize(, 1).Clear

Application.Calculation = ModCalcul
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
'--------------------------------------------

MichD
--------------------------------------------


Le 2011-01-14 07:15, a écrit :
Bonjour,

Pas compris car les données dans la feuille source (IN) sont bien en
double
pour certaines dans la colonne A (800 et 801)
La feuille (OUT EX) étant le résultat attendu après traitement par la
macro.

Le principe étant de récuper la ligne qui a la date la plus proche
lorsqu'il
y a des valeurs identiques en A
Si il n'y a qu'une valeur on prend tout simplement

On pourrait aussi imaginer detruire toutes les lignes qui sont antérieur
a
la derniere date lorsque la valeur en A est identique

J'espère avoir été plus claire

Merci
Bonne journée


"michdenis" a écrit dans le message de news:
igpbgj$5im$

Dans ta feuille source, tu étais censé avoir des doublons.
Dans l'exemple de ton classeur, tu n'as aucun doublon.

Résultat cette ligne de code plante, car elle ordonne l'affichage
de toutes les données du filtre et comme il n'y a aucune ligne
masquée par le filtre, elle n'aime pas ça !

Voici la ligne de code :
Feuil1.ShowAllData

Le remède : avant celle-ci, insère :
On Error Resume Next

Tu peux effacer cette ligne de code de la procédure, c'était
seulement un point de repère pour moi durant l'écriture de
la procédure :
ss = Rg.Columns(3).Address

MichD
--------------------------------------------
"" a écrit dans le message de groupe de discussion :
4d2f7490$0$18329$

Bonsoir

J'ai testé mais ça plante
J'ai pourtant modifié de sheet vers feuil

Pour mieux me faire comprendre je joins un fichier exemple.
En feuil1(IN) les données d'entrées
En feuil2(OUT) les données souhaitées

Voici le lien

http://cjoint.com/?0bnwWAQgqjk

Merci


"michdenis" a écrit dans le message de news:
igkv10$dbl$
Bonjour,

Essaie ceci :

Les données sont en Sheet1 , colonne A, B, C.
Les dates sont en colonne C

Le résultat est copie en Sheet2 , débutant en A1

à toi d'adapter le nom des feuilles et des plages de cellules
dans ton application.

'----------------------------------------
Sub test()
Dim DerLig As Long, Rg As Range
Dim ModCalcul As String
ModCalcul = Application.Calculation
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
'Application.ScreenUpdating = False
With Sheet1
DerLig = .Range("A:C").Cells.Find(What:="*", _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
Set Rg = .Range("A1:C"& DerLig)
End With

'En colonne D, Numérotation des lignes pour
'conserver l'ordre initial des données
Rg.Offset(, Rg.Columns.Count).Resize(, 1).Formula = "=row()"

'Trier les données sur le champ date en ordre décroissant

'Le champ 3 est supposé contenir les dates dans tableau
Rg.Sort Key1:=Rg.Columns(3), order1:=xlDescending, Header:=xlYes

'Application du filtre élaboré
ss = Rg.Columns(3).Address
Rg.Columns(3).AdvancedFilter Action:=xlFilterInPlace, Unique:=True

'Copie de la plage filtré vers la feuille Sheet2
Rg.SpecialCells(xlCellTypeVisible).Copy Sheet2.Range("A1")

'enlever le filtre de la feuille "Sheet1"
Sheet1.ShowAllData

'Remettre le tableau source comme au début
'trier sur le tableau sur la colonne ajoutée
Rg.Offset(, Rg.Columns.Count).Resize(, 1).Sort _
Key1:=1, order1:=xlAscending, Header:=xlYes

'Si tu veux tes dates en ordre croissant dans la
'feuille de résultat
With Sheet2.Range("A1")
With .CurrentRegion
.Sort Key1:=.Columns(3), order1:=xlAscending, Header:=xlYes
End With
End With

'Nettoyer la colonne ajoutée
Rg.Offset(, Rg.Columns.Count).Resize(, 1).Clear

Application.Calculation = ModCalcul
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
'----------------------------------------



MichD
--------------------------------------------
"" a écrit dans le message de groupe de discussion :
4d2da0f3$0$18329$

Bonjour,

J'ai plusieurs données sur des lignes dont certaines ont la meme
valeur
dans
une colonne.
je souhaiterai n'en conserver qu'une seule avec comme critère la
dernière
date/heure définie dans une autre colonne.
En voici un exemple simplifié

Données d'Entrées en feuille (IN)

A B
Ligne1 : 800 10/1 08:00
Ligne2 : 800 10/1 07:00
Ligne3 : 800 11/1 04:00
Ligne4 : 850 8/1 12:00
Ligne5 : 850 9/1 16:00
Ligne6 : 900 10/1 12:00
Ligne7 : 900 10/1 13:00
Ligne8: 900 10/1 9:00
Ligne9: 930 12/1 04:00
Ligne10 : 999 12/1 9:00


Résultat Souhaité sur une autre feuille (OUT)

A B
Ligne1 : 800 11/1 04:00
Ligne2 : 850 9/1 16:00
Ligne3 : 900 10/1 13:00
Ligne4 : 930 12/1 04:00
Ligne5 : 999 12/1 9:00


En fait il doit y avoir une valeur unique en A avec la dernière date
heure
(le fichier comporte environ 500 lignes)

Grand merci par avance















1 2