Microsoft 365 lien entre tableaux

[stef12345]

Bonjour,

j'aimerais créer un outil a partir de ce fichier. il faudrait que les noms de la feuille 1 (ici A,B,C...) se notent automatiquement sur la feuille 2 en fonction de leur date de fin inscrite sur la feuille 1.

A , B et C se terminent le 31 juillet 2024 sur la feuille 1 ils s'inscrivent en juillet sur ma feuille 2. je l'ai fait manuellement dans mon fichier mais j'aimerais si c'est possible que ce soit automatisé.

j'espère avoir été suffisamment clair merci de votre aide

 

[chris]

Bonjour

Une proposition PowerQuery

Le nombre d'année du résultat dépend des années des dates de fin.

Il suffit d'actualiser le tableau résultat quand la source change

 

[job75]

Bonjour stef12345, chris,

Voyez cette macro dans le code de Feuil2 qui utilise le filtre avancé :

Private Sub Worksheet_Activate()
Dim P As Range, critere As Range, c As Range
Set P = Sheets("Feuil1").[A1].CurrentRegion 'adapter le nom de la feuille
Set critere = P(2, P.Columns.Count + 2)
Application.ScreenUpdating = False
Rows("3:" & Rows.Count).Delete 'RAZ
For Each c In Range("A2", Cells(2, Columns.Count).End(xlToLeft))
    critere = "=AND(G2>=" & c.Value2 & ",G2<EDATE(" & c.Value2 & ", 1))"
    P.AdvancedFilter xlFilterInPlace, critere(0).Resize(2) 'filtre avancé
    P.Columns(1).SpecialCells(xlCellTypeVisible).Copy
    c(2).PasteSpecial xlPasteValues 'collage spécial valeurs
Next
Rows(3).Delete 'supprime les titres copiés
critere = ""
If P.Parent.FilterMode Then P.Parent.ShowAllData 'affiche tout
Application.Goto [A1], True 'cadrage
End Sub

Elle se déclenche quand on active la feuille.

A+

 

[AtTheOne]

Bonsoir à toutes & à tous,
Un essai avec des formules matricielles dynamiques, un début de période modifiable (période de 31 mois comme dans l'exemple)
Noms définis : DateDéb , DateFin (date calculée)
Nom du tableau : Liste

Le résultat n'est pas dans un tableau structuré

Formule en A2 (les entêtes) :

=TEXTE(FIN.MOIS(DateDéb;SEQUENCE(1;DATEDIF(FIN.MOIS(DateDéb;-1)+1;FIN.MOIS(DateFin;0);"M")+1;-1)+1);"mmmm aaaa")

renvoie les 21 entêtes

Formule en A3

=TRIER(FILTRE(liste[Nom];TEXTE(liste[date rapport];"mmmm aaaa")=A$2;""))

Formule à recopier sous tous les entêtes

Le résultat s'adapte automatiquement aux changements dans le tableau structuré "Liste" et en cas de changement de date de début.

Les formats conditionnels font le reste ...

 

[stef12345]

Merci pour les différentes solutions c est exactement ce que je cherchais...

 

[job75]

Bonjour le forum,

La macro de mon post #3 s'exécute en 0,34 seconde.

Toutes les colonnes du tableau en Feuil2 sont traitées.

On peut gagner du temps en ne traitant que celles dont la date est <= à juin 2025 :

Private Sub Worksheet_Activate()
Dim P As Range, critere As Range, datemax As Date, c As Range
Set P = Sheets("Feuil1").[A1].CurrentRegion 'adapter le nom de la feuille
Set critere = P(2, P.Columns.Count + 2)
datemax = Application.EoMonth(Application.Max(P.Columns(7)), 0)
Application.ScreenUpdating = False
Rows("3:" & Rows.Count).Delete 'RAZ
For Each c In Range("A2", Cells(2, Columns.Count).End(xlToLeft))
    If c > datemax Then Exit For
    critere = "=AND(G2>=" & c.Value2 & ",G2<EDATE(" & c.Value2 & ", 1))"
    P.AdvancedFilter xlFilterInPlace, critere(0).Resize(2) 'filtre avancé
    P.Columns(1).SpecialCells(xlCellTypeVisible).Copy
    c(2).PasteSpecial xlPasteValues 'collage spécial valeurs
Next
Rows(3).Delete 'supprime les titres copiés
critere = ""
If P.Parent.FilterMode Then P.Parent.ShowAllData 'affiche tout
Application.Goto [A1], True 'cadrage
End Sub

A+

 

[jcf6464]

Bonjour le forum,

Lien entre tableaux

J'aimerais créer un outil a partir de ce fichier. il faudrait que les noms de la feuille 1 (ici A,B,C...) se notent automatiquement sur la feuille 2 en fonct...

forum.excel-pratique.com

a voir

jc

 

[AtTheOne]

Bonjour à toutes & à tous, bonsoir @job75

@job75 j'ai testé ta macro avec un tableau d'entrée de 1000 lignes.
Du coup j'ai écrit une macro à ma sauce.
Je te laisse comparer

A bientôt

 

[job75]

Bonjour AtTheOne, le forum,

Utilisant des tableaux VBA et le Dictionary ton code est 15 fois plus rapide, c'est normal.

Mais sans être une usine à gaz il est un peu lourd non ?

Chez moi ma macro avec le filtre avancé s'exécute en 0,7 seconde, c'est très acceptable.

A+

 

[job75]

Ce qui ne me plait pas ce sont les dates en 2ème ligne de la feuille des résultats, ceci y remédie :

Private Sub Worksheet_Activate()
Dim P As Range, critere As Range, datemax As Date, datemin As Date, c As Range, dat As Long
Set P = Sheets("BdD").[A1].CurrentRegion 'adapter le nom de la feuille
Set critere = P(2, P.Columns.Count + 2)
datemin = Application.Min(P.Columns(7))
datemax = Application.EoMonth(Application.Max(P.Columns(7)), 0)
Application.ScreenUpdating = False
Rows("3:" & Rows.Count).Delete 'RAZ
Rows(2).ClearContents
For Each c In Range("A1", Cells(1, Columns.Count).End(xlToLeft))
    c = Application.Proper(Format(Application.EDate(datemin, c.Column - 1), "mmmm yyyy")) 'en-têtes
    dat = CDate("1/" & c)
    If dat <= datemax Then
        critere = "=AND(G2>=" & dat & ",G2<EDATE(" & dat & ", 1))"
        P.AdvancedFilter xlFilterInPlace, critere(0).Resize(2) 'filtre avancé
        P.Columns(1).SpecialCells(xlCellTypeVisible).Copy
        c(2).PasteSpecial xlPasteValues 'collage spécial valeurs
    End If
Next
Rows(2).Delete 'supprime les titres copiés
Columns.AutoFit 'ajustement largeurs
critere = ""
If P.Parent.FilterMode Then P.Parent.ShowAllData 'affiche tout
Application.Goto [A1], True 'cadrage
End Sub

 

[AtTheOne]

Bonjour à toutes & à tous, bonjour @job75
Je suis sans mon PC aujourd'hui, je regarde tout ça ce soir.
À bientôt

 

[job75]

Ceci ne nécessite plus d'intervention de l'utilisateur sur les en-têtes des résultats :

Private Sub Worksheet_Activate()
Dim P As Range, critere As Range, datemax As Date, datemin As Date, col%, x$, dat As Long
Set P = Sheets("BdD").[A1].CurrentRegion 'adapter le nom de la feuille
Set critere = P(2, P.Columns.Count + 2)
datemin = Application.Min(P.Columns(7))
datemax = Application.EoMonth(Application.Max(P.Columns(7)), 0)
Application.ScreenUpdating = False
Rows("3:" & Rows.Count).Delete 'RAZ
Columns(2).Resize(, Columns.Count - 1).Delete 'RAZ
For col = 1 To 256
    x = Application.Proper(Format(Application.EDate(datemin, col - 1), "mmmm yyyy")) 'en-têtes
    dat = CDate("1/" & x)
    If dat > datemax Then Exit For
    Cells(1, col) = x 'en-tête
    critere = "=AND(G2>=" & dat & ",G2<EDATE(" & dat & ", 1))"
    P.AdvancedFilter xlFilterInPlace, critere(0).Resize(2) 'filtre avancé
    P.Columns(1).SpecialCells(xlCellTypeVisible).Copy
    Cells(2, col).PasteSpecial xlPasteValues 'collage spécial valeurs
Next
Rows(2).Delete 'supprime les titres copiés
Columns.AutoFit 'ajustement largeurs
critere = ""
P.Parent.ShowAllData 'affiche tout
Application.Goto [A1], True 'cadrage
End Sub

 

[AtTheOne]

Bonjour à toutes & à tous

• @stef12345 : en pièce jointe un classeur avec les 4 possibilités proposées dans ce fil pour traiter ton problème, merci de faire un retour.
  
  
• @job75 : j'ai mis un timer sur chacune des solutions, chez moi (j'ai un PC de 15 d'âge) la solution par filtres élaborés successifs est plutôt pénalisante.
  
  
• @chris : j'ai essayé d'adapter tes requêtes PQ pour afficher tous les mois entre la date min et la date max comprises (et non par année complète). J'ai un peu galérer (peu familiarisé avec PQ). Du coup c'est un peu plus long à s'exécuter. (ta requête en générant les 12 mois de chaque année est bien plus rapide)
  As tu une solution plus efficace que la mienne pour générer tous les mois compris entre une date de début et une date de fin ?

voir la PJ
A bientôt

 

[chris]

RE
Une version PQ adaptée : cela semble un poil plus rapide que ton adaptation et les noms sont classés

 

[AtTheOne]

Bonjour @chris,
Merci, je regarde cela