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

[cytise95]

Bonjour,

J'ai beau cherché mais je ne trouve pas de solution à mon besoin ci-dessous :
Ayant une colonne « A » avec une liste de noms, une colonne « B » avec des dates et en colonne « E » un calendrier mensuel.
Je dois récupérer tous les noms ayant la même date en face du jour identique du calendrier dans la colonne « F » ils peuvent tous être dans la même colonne et séparés par un « ; ». Si impossible dans d’autres colonnes.
Je réussi à obtenir seulement le 1er nom correspondant à une date mais pas les éventuels noms suivants, certains en ont 4.
Afin d’être plus explicite, je joins un extrait de mon fichier.

S’il y à une solution je suis preneur.

Merci. Cordialement

 

[job75]

Bonjour cytise95,

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

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+

 

[cytise95]

Bonjour cytise95,

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

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+

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+

 

[job75]

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.

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.

 

[cytise95]

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

Ok, effectivement c'est a cause du tri, désolé de ne pas avoir compris.

Donc cette "macro" remplace la RecapNom.
Cette nouvelle macro supprime donc les noms en double, mais ça j'en ai besoin que faut-il supprimer

Les colonnes de données sont, dans le fichier réel, AW à BF.
Les colonnes recap sont CG et CH
Donc impossible d'utiliser la macro dans le vrai fichier, et je vois pas du tout ce qu'il faut modifier.
Désolé je n'ai aucune initiation en VBA, à près de 70ans je pense c'est un peu tard pour m'y mettre bien que cela semble très très intéressant pour résoudre certaines taches
Je ne voudrais pas abuser de votre temps, si vous ne pouvez pas j'abandonne. Un copier coller sera donc la seule solution.

Cordialement

 

[cytise95]

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.

Concernant la ligne de tri elle n'est pas primordiale, mais en fait c'est intéressant d'avoir les noms dans l'ordre des dates, vous aviez raison, c'est donc à conserver.

 

[cytise95]

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+

Bonjour,
Depuis hier j'essaye de comprendre le fonctionnement de la macro.
J'ai réussi a trouver comment modifier la plage des "colonnes a regrouper" et la "colonne du récap noms".
cependant, impossible de comprendre comment désactiver la suppression des doublons et aussi comment supprimer la colonne vide entre les noms et les dates.

J'ai essayé de m'inspirer de : If x <> "" Then If Not IsNumeric(x) Then d(x) = "" 'liste sans doublon .
mais cette ligne n'apparait pas dans la macro du post #16
Cordialement

 

[job75]

Bonsoir,

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

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

A+

 

[cytise95]

Bonsoir,

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

A+

Bonsoir Job75,
Merci de votre réponse.

J'ai indiqué en poste post #15 "Tous mes essais récupèrent la 1ére date correspondant à un nom en double. S'il n'y à pas de doublon avec "SIERREUR" cela fonctionne bien, mais impossible de trouver une autre solution satisfaisante" je voulais dire que je récupérai uniquement la 1er date mais je ne disais pas que cela me convenanait.

En fait comme je disais dans le post #14 : "Concernant les noms en double, en fait ce ne sont pas des doublons mais des dates différentes pour certaines personnes"
Donc j'en ai vraiment besoin.
Cdlt

 

[job75]

Bonjour cytise95, le forum,

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

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+

 

[cytise95]

Bonjour cytise95, le forum,

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

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+

Bonjour Job75,
Grand merci de votre aide.
J'ai transcrit la macro dans mon fichier, cela fonctionne à merveille.
Effectivement je n'aurai pas trouver comment effectuer les modifs de cette macro. Je n'avais donc aucune chance de réussir.
Ce post est donc clôturé pour moi. Bravo a vous
Merci encore et bon dimanche.
Cordialement
Christian

 

[cytise95]

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

 

[cytise95]

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

Désolé du dérangement.
J'ai trouvé la cause en faisant un affichage a 20%.
En fait, j'avais masqué des colonnes puis j'avais fait un figer les volets à droite de colonnes masquées. Lors de la suppression de celles-ci le figer est resté.
Encore désolé

Bonne soirée
Cordialement
Christian