XL 2013 formule de recherche par mois

[Camille123]

Bonjour
j'ai une feuil 01 excel dans le quel se trouve des données et des dates aléatoires sur plusieurs colonnes
par exemple
colonne A colonne B colonne C
a 12/07/2019 12/09/2019
b 05/05/2019 01/07/2019
c 08/10/2020 08/08/2020
d 08/02/2019 07/08/2019
j'aimerais que dans ma feuil 02 il est une formule permetant de les classés par mois et année
colonne A janv2019 fev2019 ….
a
b
c
d
Merci pour votre aide.

 

[job75]

mais y'a t'il une possibilité pour que si j'ajoute d'autre items aux lignes suivante qu'il le prend en compte?

Vous voulez dire faire en sorte que les items de la feuille "compilation" correspondent exactement aux items de la feuille "Synthese" ?

C'est un autre problème mais bien sûr c'est possible, il faudrait que vous indiquiez exactement ce que vous voulez faire (ajout/suppression).

 

[Camille123]

Vous voulez dire faire en sorte que les items de la feuille "compilation" correspondent exactement aux items de la feuille "Synthese" ?

C'est un autre problème mais bien sûr c'est possible, il faudrait que vous indiquiez exactement ce que vous voulez faire (ajout/suppression).

je voudrais ajouter des items a la suite de la ligne 143 de synthese et ajouter les memes nouveau items a la suite de la la ligne 110 dans la compilation pour qu'il les recherche aussi

 

[job75]

Voyez la macro dans le code de la feuille "Synthese" de ce fichier (3) :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, Range("C40:C" & Rows.Count)) Is Nothing Or Target(1) = "" Then Exit Sub
Cancel = True
With Feuil3 'CodeName de la feuille compilation
    If Application.CountIf(.[C:C], Target.Value) Then MsgBox "L'item '" & Target & "' existe déjà en feuille 'compilation'...": Exit Sub
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    With .Cells(.Rows.Count, 3).End(xlUp).EntireRow
        .Copy .Rows(2)
        .Rows(2) = ""
        .Cells(2, 3) = Target
    End With
    MsgBox "L'item '" & Target & "' a été ajouté en feuille 'compilation'..."
End With
End Sub

Dans la feuille "compilation" le code est modifié pour adapter les plages :

Private Sub Worksheet_Activate()
Dim tablo, ncol%, d As Object, i&, j%, dat As Date, mois, item, x$
'---liste feuille Synthese---
With Feuil55 'CodeName de la feuille Synthese
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    tablo = .Range("C40:X" & .Range("C" & .Rows.Count).End(xlUp).Row) 'matrice, plus rapide
End With
ncol = UBound(tablo, 2)
Set d = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(tablo)
    For j = 12 To ncol
        If IsDate(tablo(i, j)) Then
            dat = DateSerial(Year(tablo(i, j)), Month(tablo(i, j)), 1)
            d(dat & tablo(i, 1)) = tablo(i, j) 'mémorise la date
        End If
Next j, i
'--tableau feuille compilation---
If FilterMode Then ShowAllData 'si la feuille est filtrée
With Range("G7:BE" & Range("C" & Rows.Count).End(xlUp).Row)
    tablo = .Value 'matrice, plus rapide
    ncol = UBound(tablo, 2)
    mois = .Rows(-1) '2 lignes au-dessus
    item = .Columns(-3) '4 colonnes à gauche
    For i = 1 To UBound(tablo)
        For j = 1 To ncol
            If IsDate(mois(1, j)) Then tablo(i, j) = d(CDate(mois(1, j)) & item(i, 1))
    Next j, i
    .Value = tablo 'restitution
End With
End Sub

 

[Camille123]

Voyez la macro dans le code de la feuille "Synthese" de ce fichier (3) :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, Range("C40:C" & Rows.Count)) Is Nothing Or Target(1) = "" Then Exit Sub
Cancel = True
With Feuil3 'CodeName de la feuille Synthese
    If Application.CountIf(.[C:C], Target.Value) Then MsgBox "L'item '" & Target & "' existe déjà en feuille 'compilation'...": Exit Sub
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    With .Cells(.Rows.Count, 3).End(xlUp).EntireRow
        .Copy .Rows(2)
        .Rows(2) = ""
        .Cells(2, 3) = Target
    End With
    MsgBox "L'item '" & Target & "' a été ajouté en feuille 'compilation'..."
End With
End Sub

Dans la feuille "compilation" le code est modifié pour adapter les plages :

Private Sub Worksheet_Activate()
Dim tablo, ncol%, d As Object, i&, j%, dat As Date, mois, item, x$
'---liste feuille Synthese---
With Feuil55 'CodeName de la feuille Synthese
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    tablo = .Range("C40:X" & .Range("C" & .Rows.Count).End(xlUp).Row) 'matrice, plus rapide
End With
ncol = UBound(tablo, 2)
Set d = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(tablo)
    For j = 12 To ncol
        If IsDate(tablo(i, j)) Then
            dat = DateSerial(Year(tablo(i, j)), Month(tablo(i, j)), 1)
            d(dat & tablo(i, 1)) = tablo(i, j) 'mémorise la date
        End If
Next j, i
'--tableau feuille compilation---
If FilterMode Then ShowAllData 'si la feuille est filtrée
With Range("G7:BE" & Range("C" & Rows.Count).End(xlUp).Row)
    tablo = .Value 'matrice, plus rapide
    ncol = UBound(tablo, 2)
    mois = .Rows(-1) '2 lignes au-dessus
    item = .Columns(-3) '4 colonnes à gauche
    For i = 1 To UBound(tablo)
        For j = 1 To ncol
            If IsDate(mois(1, j)) Then tablo(i, j) = d(CDate(mois(1, j)) & item(i, 1))
    Next j, i
    .Value = tablo 'restitution
End With
End Sub

Job75 merci encore pour ta disponibilité c'est parfait