XL 2019 extraire toute les cellules d'une colonne ayant une date identique

job75 à dit:

Bonjour cytise95,

Comme pour la macro du post #13 il faut ici le Dictionary mais en utilisant en plus les items :

VB:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim dest As Range, d As Object, tablo, ub&, j%, i&, x$, a, b, c()
Set dest = [J3] '1ère cellule de destination, à adapter
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
tablo = Range("A3:H" & Cells.SpecialCells(xlCellTypeLastCell).Row).Value2 'matrice, plus rapide
ub = UBound(tablo)
For j = 1 To UBound(tablo, 2) Step 2
    For i = 1 To ub
        x = Trim(CStr(tablo(i, j)))
        If x <> "" Then If Not d.exists(x) Then d(x) = tablo(i, j + 1) 'mémorise la date dans les items
Next i, j
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les évènements
If d.Count Then
    a = d.keys: b = d.items
    ReDim c(UBound(a), 2) 'base 0
    For i = 0 To UBound(a): c(i, 0) = a(i): c(i, 2) = b(i): Next 'transposition
    With dest.Resize(d.Count, 3)
        .Value = c 'restitution
        .Columns(1).Interior.Color = RGB(255, 255, 204) 'jaune clair
        .Columns(3).NumberFormat = "dd mmmm yyyy" 'format date
        .Sort .Columns(3), xlAscending, Header:=xlNo 'tri sur les dates
    End With
End If
dest.Offset(d.Count).Resize(Rows.Count - d.Count - dest.Row + 1, 3).Clear 'RAZ en dessous
Application.EnableEvents = True 'réactive les évènements
With UsedRange: End With 'actualise la barre de défilement verticale
End Sub

J'ai aussi ajouté un tri sur les dates.

A+

Cliquez pour agrandir...

cytise95 à dit:

Par contre, la liste de la récap commence seulement à la 5eme ligne. Les lignes 3 et 4 ne sont donc plus prisent en compte.

Cliquez pour agrandir...

job75 à dit:

Allons allons, regardez mieux : les noms en A3 et A4 se retrouvent en J6 et J7 à cause du tri.

Et puisque vous ne voulez pas de tri supprimez la ligne de code correspondante.

Par ailleurs vous n'avez pas compris que RecapNom est une fonction VBA utilisée au post #12 uniquement et remplacée aux posts #13 et #16 par une procédure Sub

Cliquez pour agrandir...

job75 à dit:

Allons allons, regardez mieux : les noms en A3 et A4 se retrouvent en J6 et J7 à cause du tri.

Et puisque vous ne voulez pas de tri supprimez la ligne de code correspondante.

Par ailleurs vous n'avez pas compris que RecapNom est une fonction VBA utilisée au post #12 uniquement et remplacée aux posts #13 et #16 par une procédure Sub.

Cliquez pour agrandir...

cytise95 à dit:

Merci encore a vous, toujours en train d'aider les autres c'est merveilleux.

Si je comprend bien il n'y a pas de formule pour effectuer cette manip, dommage pour moi car je ne maitrise pas les macros.

Je ne vois plus la macro "RecapNom" ni d'ailleurs la nouvelle pour les dates
Par contre, la liste de la récap commence seulement à la 5eme ligne. Les lignes 3 et 4 ne sont donc plus prisent en compte. Je ne vois pas comment avoir accès pour une éventuelle correction, sachant que cette macro doit être transcrite dans le vrai fichier.
Pour info les doublons son autorisés et le tri par date pas du tout utile.

A+

Cliquez pour agrandir...

Si un nom apparait avec plusieurs date, seule la 1ere date est prise en compte

Cliquez pour agrandir...

job75 à dit:

Bonsoir,

Il faut conserver la suppression des doublons, vous le dites vous-même sur le fichier du post #15 :

A+

Cliquez pour agrandir...

job75 à dit:

Bonjour cytise95, le forum,

Dans le fichier (2) cette macro liste tous les noms et dates même en doublon :

VB:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim dest As Range, tablo, ub&, resu(), j%, i&, x$, n&
Set dest = [J3] '1ère cellule de destination, à adapter
tablo = Range("A3:H" & Cells.SpecialCells(xlCellTypeLastCell).Row).Value2 'matrice, plus rapide
ub = UBound(tablo)
ReDim resu(1 To ub * UBound(tablo, 2), 1 To 2)
For j = 1 To UBound(tablo, 2) Step 2
    For i = 1 To ub
        x = Trim(CStr(tablo(i, j)))
        If x <> "" Then n = n + 1: resu(n, 1) = x: resu(n, 2) = tablo(i, j + 1)
Next i, j
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les évènements
If n Then
    With dest.Resize(n, 2)
        .Value = resu 'restitution
        .Columns(1).Interior.Color = RGB(255, 255, 204) 'jaune clair
        .Columns(2).NumberFormat = "dd mmmm yyyy" 'format date
        .Sort .Columns(2), xlAscending, Header:=xlNo 'tri sur les dates, facultatif
    End With
End If
dest.Offset(n).Resize(Rows.Count - n - dest.Row + 1, 2).Clear 'RAZ en dessous
Application.EnableEvents = True 'réactive les évènements
With UsedRange: End With 'actualise la barre de défilement verticale
End Sub

Comme déjà dit elle se déclenche quand on modifie ou valide une cellule quelconque.

A+

Cliquez pour agrandir...

cytise95 à dit:

Bonsoir Job75,

La macro fonctionne a merveille et j'ai réussi a finaliser le fichier, je suis en cours de mise à jour des données.
Cependant depuis hier, je ne peut plus naviguer dans les colonnes. Le curseur horizontale bouge bien mais sans effet. Lorsque je fais défiler les cellules vers la droite (avec la flèche) j'obtiens le contenu des cellules dans la barre des formules en haut mais c'est tout.
Hier cela ne me gênait pas car j'effectue la saisie dans les autres onglets. Mais la je voudrais visualiser le résultat et ce n’est pas possible. Avant hier c'était possible, malgré que cette gene était apparue à quelques reprises.

On m'a indiqué que cela provient en général d'une macro.

With UsedRange: End With 'actualise la barre de défilement verticale
Votre macro peut elle en être la cause ?

Cordialement
Christian

Cliquez pour agrandir...