Fusion tableau avec doublons, triplons, quadruplons....

Résolu/Fermé
julia Namor Messages postés 524 Date d'inscription jeudi 27 mars 2014 Statut Membre Dernière intervention 13 janvier 2024 - 16 janv. 2023 à 22:16
 PierrotLeFou - 19 janv. 2023 à 00:47

bonjour

j’ai un tableau de rdvs extrait d'un programme . Ce tableau me sort toutes les personnes avec tous les rdv qui ont eu lieu.

je voudrais fusionner et ne garder que la ligne du dernier rdv en date .

Je vous joins un fichier en exemple

https://www.transfernow.net/en/dltransfer?utm_source=20230116ecCifPPS&utm_medium=ijsxddBG

merci de votre aide


Windows / Firefox 108.0

A voir également:

6 réponses

PierrotLeFou
17 janv. 2023 à 00:56

Tu n'as qu'à trier ton fichier par ordre alphabétique des personnes et par ordre de date comme deuxième clé.
Qu'est-ce que tu as fait jusqu'à maintenant?

0
julia Namor Messages postés 524 Date d'inscription jeudi 27 mars 2014 Statut Membre Dernière intervention 13 janvier 2024 33
17 janv. 2023 à 21:55

Bonsoir

Merci pour ta réponse l'idée est bonne ; j'ai fait ceci

Sub trier()
    Range("$A$1:$C$142").Select
    Selection.Columns.Sort key1:=Columns("c"), Order1:=xlAscending, Key2:=Columns("a"), Order2:=xlAscending, Header:=xlYes
End Sub

du coup , comment supprimer les  lignes en doublons ou triplons avec les anciennes dates

Merci de votre aide

0
julia Namor Messages postés 524 Date d'inscription jeudi 27 mars 2014 Statut Membre Dernière intervention 13 janvier 2024 33
Modifié le 17 janv. 2023 à 22:31

J'ai fait ce code qui ma foi est basique mais semble fonctionner

Quel est votre avis .?

Sub supp()
Dim cell As Range
Dim cell1 As Range
For Each cell In Range("$A$2:$A$142")
'cell.Offset(0, 2)
For Each cell1 In Range("$A$2:$A$142")
If cell.Address <> cell1.Address And cell.Value = cell1.Value And cell.Offset(0, 1).Value = cell1.Offset(0, 1).Value And cell.Offset(0, 2).Value < cell1.Offset(0, 2).Value Then
'MsgBox (cell1.Value)
cell1.Select
  ActiveCell.EntireRow.Delete Shift:=xlUp
End If
Next cell1
 Next cell
End Sub
0

J'ai répondu un peu rapidement, je n'ai pas remarqué que tu étais en VB / VBA.
En général, on lit chaque entrée, puis on la place dans un espace "temporaire".
On lit la suivante et on la compare avec le temporaire.
Si c'est pareil (ici le nom), on remplace le temporaire par la suivante.
Sinon, on écrit le temporaire en sortie et on place la suivante dans le temporaire.
Il faut juste faire attention au début et à la fin.
Au début, on place quelque chose de reconnaissable dans le temporaire. Si c'est ça qui s'y trouve, on n'écrit rien.

On peut toujours passer à côté de ceci en lisant la première entrée hors de la boucle. Le temporaire contiendra toujours quelque chose de valide.
À la fin, il reste quelque chose dans le temporaire. On l'écrit inconditionnellement.
Ceci ne fonctionne que si le fichier est trié comme j'ai mentionné.

0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
julia Namor Messages postés 524 Date d'inscription jeudi 27 mars 2014 Statut Membre Dernière intervention 13 janvier 2024 33
18 janv. 2023 à 23:19

Bonjour

Merci de ta réponse , mais désolé j’ai beau lire et relire je n'y comprends rien .

Pour en revenir a mon code ci dessus . IL fonctionne mais je suis obligé de le relancer deux a trois fois pour avoir un traitement fini .

Quelqu’un pourrait il me le modifier pour une efficacité sur un seule exécution?

Merci d'avance

0
PierrotLeFou
19 janv. 2023 à 00:47

Tu l'auras compris, je ne connais pas ce langage.
J'ai essayé de modifier ton code pour expliquer ce que je voulais dire.
J'ai mis des commentaires avec des '...'
 
Sub supp()
Dim cellIn As Range
Dim cellOut As Range
... Placer la première entrée dans cellOut
... S'aranger pour commencer à la seconde entrée.
For Each cellIn In Range("$A$2:$A$142")
'cellIn.Offset(0, 2)  ... Ça fait qoi ?
... Ci-après si les noms sont différents
If cellIn.Address <> cellOut.Address And cellIn.Value = cellOut.Value And cellIn.Offset(0, 1).Value = cellOut.Offset(0, 1).Value And cellIn.Offset(0, 2).Value < cellOut.Offset(0,
2).Value Then
'MsgBox (cellOut.Value)   ... Tu écris en sortie ?
End If
... Ici tu recopies cellIn dans cellOut
 Next cellIn
'MsgBox (cellOut.Value)   ... Tu écris en sortie ?
End Sub

0