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

Gégé-45550

XLDnaute Accro

• 30 Janvier 2024

• #2

Rabeto à dit:

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,

Cliquez pour agrandir...

Bonjour,
Une proposition sans VBA mais facilement transposable.
Cordialement

 

Pièces jointes

• Recherche Rabeto.xlsx

  23.1 KB · Affichages: 11

Vote positif 1 Vote négatif

patty58

XLDnaute Occasionnel

• 30 Janvier 2024

• #3

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

 

Vote positif 0 Vote négatif

R

Rabeto

XLDnaute Occasionnel

• 30 Janvier 2024

• #4

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

 

Vote positif 0 Vote négatif

patty58

XLDnaute Occasionnel

• 30 Janvier 2024

• #5

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

 

Vote positif 0 Vote négatif

R

Rabeto

XLDnaute Occasionnel

• 30 Janvier 2024

• #6

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

 

Pièces jointes

• Recherche Rabeto (1).xlsx

  12.4 KB · Affichages: 6

Vote positif 0 Vote négatif

patty58

XLDnaute Occasionnel

• 30 Janvier 2024

• #7

Rebonjour
Essaie de mettre cette macro dans un module

VB:

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

 

Vote positif 0 Vote négatif

Solution

R

Rabeto

XLDnaute Occasionnel

• 30 Janvier 2024

• #8

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

 

Vote positif 0 Vote négatif

R

Rabeto

XLDnaute Occasionnel

• 31 Janvier 2024

• #9

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 ?

 

Vote positif 0 Vote négatif

patty58

XLDnaute Occasionnel

• 31 Janvier 2024

• #10

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

 

Vote positif 0 Vote négatif

R

Rabeto

XLDnaute Occasionnel

• 31 Janvier 2024

• #11

mais non patty58, il n'y aura pas de critique selon moi

J'ai testé et cela fonctionne bien juste le temps d'exécution mais je penses que c'est aussi la meilleur solution vu que le délai dépend aussi du nombre des cellules que la macro traite,

d'ailleurs j'ai mis votre réponse comme étant la résolution,

 

Vote positif 0 Vote négatif

Gégé-45550

XLDnaute Accro

• 31 Janvier 2024

• #12

Rabeto à dit:

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 ?

Cliquez pour agrandir...

Bonjour,
Essayez ça :

VB:

Sub Calendrier()
Dim i%, j%, derlig%, Debut(), Fin(), finCal&, Dates()
Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    derlig = ws.Range("A" & Rows.Count).End(xlUp).Row
    finCal = ws.Cells(2, ws.Columns.Count).End(xlToLeft).Column
    ReDim Dates(finCal - 7)
    For i = 8 To finCal
        Dates(i - 8) = Int(CDbl(ws.Cells(2, i).Value))
    Next i
    ReDim Debut(derlig - 2)
    ReDim Fin(derlig - 2)
    For i = 2 To derlig
        Debut(i - 2) = Int(CDbl(ws.Range("C" & i).Value))
        Fin(i - 2) = Int(CDbl(ws.Range("D" & i).Value))
    Next i
    For i = LBound(Debut) To UBound(Debut) - 1
        For j = LBound(Dates) To UBound(Dates) - 1
            If Debut(i) <= Dates(j) And Fin(i) >= Dates(j) Then
                ws.Cells(i + 3, j + 8) = ws.Cells(i + 2, 2)
            End If
        Next j
    Next i
End Sub

Cordialement,

 

Vote positif 0 Vote négatif

R

Rabeto

XLDnaute Occasionnel

• 4 Février 2024

• #13

Bonjour, Gégé-45550 et patty58
merci pour vos réponses,

Gégé-45550 : merci, J'ai essayé le code, mais le résultat donne autre chose quand j'ajoute plus de donnée, dans le ficher avec votre pseudo

patty58 : Une dernière chose svp, (dans le ficher avec votre pseudo) j'ai essayé de modifier votre code en adaptant un peu les valeurs selon le model final du fichier mais je n'y arrive pas

 

Pièces jointes

• Recherche Rabeto patty58.xlsm

  174.6 KB · Affichages: 7
• Recherche Rabeto Gégé-45550.xlsm

  85 KB · Affichages: 4

Vote positif 0 Vote négatif

dysorthographie

XLDnaute Accro

• 4 Février 2024

• #14

Bonjour,

Code:

'Ws.Range("A65536").End(xlUp).Row
Ws.cells(rows.count,"A").End(xlUp).Row

Ça fait bien longtemps qu'on est plus en xls mais en xlsx!

@Rabeto ton application doit tourner sur Windows et\ou Mac ?

 

Vote positif 0 Vote négatif

R

Rabeto

XLDnaute Occasionnel

• 4 Février 2024

• #15

Bonjour dysorthographie

C'est sur Windows

 

Vote positif 0 Vote négatif