XL 2019 Recherche valeur (Critère date et ID) et copier valeur dans tableau dans la cellule correspondante

[Rabeto]

Bonjour,

J'aimerai faire une recherche de valeur dans la colonne Type en se basant sur 2 critères (ID et Date) et placer les résultats dans la cellule concernée du tableau.

Je vous joint un fichier pour mieux expliquer la demande, mais c'est juste un exemple.

Il se trouve que je pourrai avoir une centaine d'ID avec des dates allant jusqu'à la fin de l'année.

Par macro si possible

merci,

 

[Gégé-45550]

Bonjour,

J'aimerai faire une recherche de valeur dans la colonne Type en se basant sur 2 critères (ID et Date) et placer les résultats dans la cellule concernée du tableau.

Je vous joint un fichier pour mieux expliquer la demande, mais c'est juste un exemple.

Il se trouve que je pourrai avoir une centaine d'ID avec des dates allant jusqu'à la fin de l'année.

Par macro si possible

merci,

Bonjour,
Une proposition sans VBA mais facilement transposable.
Cordialement

 

[Cousinhub]

Par macro si possible

Bonjour,
Hélas...
Power Query pourrait-il faire l'affaire?
2 ou 3 secondes pour remplir
De plus, comme tu travailles par demi-journée, tu peux avoir des Types différents pour la même journée (Ex: l'ID 8053, le 04/10/2023, matin en CP, apm en TT)

Si ça t'intéresse, bien sûr...
Bonne fin d'apm

 

[patty58]

Bonsoir à tous
Je joins de nouveau un fichier à tester, mais je suis fatiguée et j'en perds mon latin
Vois si cela convient mieux

 

[dysorthographie]

Bonjour,

 

[job75]

Non, vous pouvez conserver les anciennes données et supprimer les lignes en doublons sur A B C D.

Voici la nouvelle macro, très simple :

Private Sub Worksheet_Activate()
Dim derlig&
Application.ScreenUpdating = False
If FilterMode Then ShowAllData 'si la feuille est filtrée
[F1].CurrentRegion.Offset(1).ClearContents 'RAZ
derlig = Range("A" & Rows.Count).End(xlUp).Row
Sheets("Nouvelles Valeurs").[A1].CurrentRegion.Offset(1).Copy Cells(derlig + 1, 1) 'copier-coller
[A1].CurrentRegion.RemoveDuplicates Array(1, 2, 3, 4), Header:=xlYes 'supprime les doublons
derlig = Range("A" & Rows.Count).End(xlUp).Row
[A1].CurrentRegion.Sort Columns(1), xlAscending, Header:=xlYes 'tri
Range("F1:F" & derlig) = Range("A1:A" & derlig).Value
If derlig > 1 Then Range("F1").AutoFill Range("F1:F" & derlig), xlFillFormats
Range("G2:NH2") = "=REPT($B2,AND(G$1>=INT($C2),G$1<INT($D2)+1))"
If derlig > 2 Then Range("G2:NH2").AutoFill Range("G2:NH" & derlig)
Rows(IIf(derlig = 1, 2, derlig) + 1 & ":" & Rows.Count).Delete 'RAZ en dessous
With UsedRange: End With 'actualise la barre de défilement verticale
End Sub

Je ne cherche pas à supprimer les formules après les avoir entrées.

 

[job75]

Pour faire gagner du temps j'ai ajouté :

[F1].CurrentRegion.Offset(1).ClearContents 'RAZ

Voyez le fichier joint avec 901 lignes, chez moi sur Win 11 Excel 2019 => 0,9 seconde.

 

[patty58]

Bonjour à vous deux, bonjour à tous
Je vois que par exemple, pour l'ID 8045, tu as :
CP du 15/01 au 28/01 et TT du 14/01 au 29/01, le 27 et et le 26 (qui sont d'ailleurs inclus dans la première période), mais donc du 15 au 28 , tu as CP ET TT
Comment faire, que te faut-il exactement ??
A plus

 

[Rabeto]

Bonjour Gégé-45550 et patty58

Merci pour vos réponses

l'ID 8045 : erreur de ma part, les types ne doivent pas se chevaucher sur une même période, soit TT soit CP

 

[patty58]

Donc peux-tu corriger ton fichier pour que l'on puisse travailler sur une base valide ?
Si les formules de Gégé te conviennent, bien sûr , on arrête là.
Bonne fin de journée

 

[Rabeto]

Les formules de Gégé répondent bien à ma demande et j'admire beaucoup le travail, c'est sur que cela me servirai à d'autre chose.
Mais comme mentionné dans poste 1, les jours peuvent s'étaler jusqu'à la fin de l'année et la liste ID jusqu'à des centaines, donc avec les formules cela risque de rendre le fichier lourd.

D'où je cherche une autre façon par macro

PS : J'ai complètement changer les ID pour éviter les doublon dans la liste

 

[patty58]

Rebonjour
Essaie de mettre cette macro dans un module

Global DLig, Ws, DatDeb, DatFin, DColDeb, DColFin
Sub Placer()
Set Ws = ActiveSheet
DLig = Ws.Range("A65536").End(xlUp).Row
DColDeb = 8
DColFin = 38
'rech date corresp   col date deb
For ind = 2 To DLig
    DatDeb = DateValue(Ws.Cells(ind, 3))
    DatFin = DateValue(Ws.Cells(ind, 4))
    For ColD = DColDeb To DColFin
        If Ws.Cells(2, ColD) = DatDeb Then
            ColDat = ColD
            Call RechercheLigneType(ind, Ws.Cells(ind, 1), ColDat)
            Exit For
        End If
    Next ColD
Next ind
End Sub

Sub RechercheLigneType(LigTyp, Id, Col)
    For Lig = 3 To DLig + 1
        If Ws.Cells(Lig, 7) = Id Then
            Ws.Cells(Lig, Col) = Ws.Cells(LigTyp, 2)
            Col = Col + 1
            While Ws.Cells(2, Col) <= DatFin And Col < DColFin
                Ws.Cells(Lig, Col) = Ws.Cells(LigTyp, 2)
                Col = Col + 1
            Wend
        End If
    Next
End Sub

Cela semble fonctionner, mais il faut vraiment que ton fichier soit cohérent, pas comme avant !
Bonne soirée

 

[Rabeto]

merci patty58

Oui ça fonctionne, je vais essayer de comprendre tes codes,

L'exécution de la macro prend un peu de temps mais ça marche

 

[Rabeto]

Bonjour patty58,

J'ai appliqué le code sur un planning allant jusqu'à fin Décembre 2024 avec une centaine d'ID et ça prend vraiment du temps, est ce normal stp ?

 

[patty58]

Bonjour Rabeto
Je peux regarder mais j'aime programmer, mais je suis "basique". Il faudrait que tu demandes de l'aide à quelqu'un d'autre en demandant d'améliorer ce code qui est trop lent
J'aurai certainement des critiques, mais tant pis
Bonne journée