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

Rabeto

XLDnaute Occasionnel
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,
 

Pièces jointes

  • Recherche Rabeto.xlsx
    12.2 KB · Affichages: 22
Solution
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)...

Rabeto

XLDnaute Occasionnel
Bonjour patty58 / job75 / Cousinhub

job75 : Je dois changer les données dans BCD car ce sont des données issus d'une extraction et je dois faire la maj chaque jour, si je garde les données, le fichier risque de devenir très lourd au fur et à mesure que j'alimente avec de nouvelle donnée

Cousinhub : J'étais pas juste précis dès le début, je pensais qu'un simple fichier et quelque explication pourrait vous aider, mes excuses.

patty58 : Oui, c'est exactement ça, nickel c'est le but à 100%
Je ne vous embêterai plus après ce dernier point,
est ce possible d'ajouter un code comme quoi si la cellule contient déjà quelque chose, effacer et remplacer par la nouvelle valeur
ou bien le contraire, si la cellule contient quelque chose, ne rien faire
 

patty58

XLDnaute Occasionnel
Bonjour à tous,
si la cellule contient déjà quelque chose, effacer et remplacer par la nouvelle valeur
ou bien le contraire, si la cellule contient quelque chose, ne rien faire
Je ne comprend pas du tout le but de ton travail, mais ce que tu demandes là est bizarre, Si je comprend , cela veut dire que tu te moques complètement que ce soit une valeur ou une autre.
En clair, tu veux dire que tu ne veux pas voir 2 ou 3 valeurs du style TT/CP, mais une seule ??
 

Rabeto

XLDnaute Occasionnel
tu veux dire que tu ne veux pas voir 2 ou 3 valeurs du style TT/CP, mais une seule ??
En faite, le dernier fichier est déjà bon,
Je souhaite garder le type de valeurs, TT/CP si un ID a 2 types différents avec la même date.

Mais si vous reprenez le dernier fichier, chaque fois qu'on actualise la macro, de nouvelle donnée s'ajoute dans les cellules ex le 03/O1 pour 8010 on a CP/CP/CP si on actualise 3 fois la macro, le but est de ne pas changer les valeurs si la cellule contient déjà des données, il y avait déjà un CP.
Car je mets à jours la base dans colonne A:H quotidiennement.
Si une cellule contient déjà des données, soit remplacer par une nouvelle valeur trouvé dans A:H soit ne rien faire c'est tout ce qui est à rajouté dans la macro.

je comprends si c'est trop demandé, je devais donner plus de précision au début.
 
Dernière édition:

job75

XLDnaute Barbatruc
Bonhour Rabeto, le forum,
job75 : Je dois changer les données dans BCD car ce sont des données issus d'une extraction et je dois faire la maj chaque jour, si je garde les données, le fichier risque de devenir très lourd au fur et à mesure que j'alimente avec de nouvelle donnée
Non, vous pouvez conserver les anciennes données et supprimer les lignes en doublons sur A B C D.

A+
 

job75

XLDnaute Barbatruc
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 :
VB:
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.
 

Pièces jointes

  • Recherche Rabeto(3).xlsm
    90.5 KB · Affichages: 1
Dernière édition:

job75

XLDnaute Barbatruc
Pour faire gagner du temps j'ai ajouté :
VB:
[F1].CurrentRegion.Offset(1).ClearContents 'RAZ
Voyez le fichier joint avec 901 lignes, chez moi sur Win 11 Excel 2019 => 0,9 seconde.
 

Pièces jointes

  • Test(1).xlsm
    46 KB · Affichages: 4

Cousinhub

XLDnaute Barbatruc
Inactif
Pas sur mon fichier ni sur celui du post #1, restons simples.

Je ne vois pas l'intérêt de faire des 1/2 journées pour compliquer les choses inutilement.
Bonjour Job
Je ne comprends pas du tout ton "restons simples"
Le demandeur l'a dit lui-même...
Il s'est trompé dans son 1er fichier, justement pour "faire simple", mais si tu lis tout le fil, tu t'en rendras compte...
Et toute journée peut-être décomposée, notamment pour les RTT, si accord
1707242057170.png

Bonne soirée
 

ChTi160

XLDnaute Barbatruc
Bonjour Rabeto ,Le Fil
je regarde ce fil et je me pose des questions Lol
tu as au Post #13 dans le Fichier de Patty
2023-01-01 13:30:00​
2023-01-01 13:30:00​
0,5
le 0,5 correspond a quoi ?
peux tu avoir des périodes qui chevauchent 2 mois ?
quelles Sont les Limites de 9:00 à 12:30 puis de 13:30 à 18:00
les demandes sont faites a partir de ces Horaires ?
Exemple pour le Jour de début de 13:30 si la personne travaille le Matin et 9:00 si la personne pose toute la Journée .
pour le Jour de Fin 12:30 si la personne travaille l'après midi et 18:00 si elle ne travaille pas de la Journée .

Bonne fin de Journée
jean marie
 

Discussions similaires

Statistiques des forums

Discussions
315 093
Messages
2 116 133
Membres
112 667
dernier inscrit
foyoman