Rechercher plusieurs éléments communs sur deux onglets
Bonjour,
Je me permets de faire appel à vos compétences d'experts :) qui m'ont été prouvées déjà à plusieurs fois.
En fait, je voudrais m'assurer que lorsqu'un salarié s'absente pour des raisons X ou Y(maladie etc...) qu'il n'en profite pas pour utiliser sa carte essence à des fins personnelles.
Pour cela, j'ai construit deux tableaux qui sont composés de peu de ligne afin d'illustrer (le fichier BDD fait environ + de 7000 lignes pour chaque onglet).
Dans le fichier, il y a deux onglets.
Le 1er onglet BDD est la base de données où j'aurais toutes les informations de consommation (date et heure sur la même cellule) sur lequel nous avons le MATRICULE qui définit l'identifiant du salarié mais également la date de consommation (l'heure indiquée m'importe peu) qui est super importante
Le 2ème onglet correspond aux données d'absences des différentes personnes sur lequel on retrouve plusieurs éléments mais surtout le matricule du salarié ainsi que les différentes périodes pour lesquelles il s'est absenté.
Je ne pouvais pas utiliser de Recherchev car il peut y avoir plusieurs lignes pour un même matricule d'un côté comme de l'autre, ainsi que des dates pouvant être à cheval, je ne vois qu'une macro capable de gérer ce type de problématique.
A la toute fin, vous remarquerez que j'ai créé une colonne que j'ai surligné en marron pour que grâce à la macro, elle soit capable de me dire que pour cet employé, celui-ci a consommé alors qu'il était sensé être absent(maladie ou autre) donc par exemple une réponse type " OUI";
PI : toutes les autres colonnes certaines sont remplies d'autres non, je les ai laissées car elle constitue mon extraction.
J'espère que c'est clair
Salut Nextia,
supposons que le brave homme, tout malade et fiévreux, fasse l'effort de prévoir son plein d'essence pendant sa maladie, histoire d'être plus vite au boulot après sa guérison ?!
Mériterait plutôt une médaille, non ?
A+
bonsoir, je n'arrivais pas à insérer du texte dans mon précédent message...Bref
J'ai ajouté manuellement 2 lignes et j'ai décalé en dessous la ligne où se situe des chiffres (qu'est-ce que c'est?) et en cliquant sur la macro, elle ne réagit pas.
Merci pour ton retour et ton aide
ps : n'hésite pas si tu peux contribuer à ma recherche
merci bcp ;)
J'ai ajouté manuellement 2 lignes
J''ai vu ça sur le nouveau fichier que tu as joint.
Sur la feuille BDD tu as ajouté BOFO MERICI et indiqué la date du 02/05/2020 11:32 en colonne O
Puis une nouvelle fois la même personne à la ligne suivante et la date du 03/05/2020 en colonne O
Sur la feuille Absences salariée, tu as ajouté deux lignes pour indiquer que cette même personne était en absence :
du 01/05/2020 a 02/03/2020 et
du 06/05/2020 au 07/05/2020
Les deux dates de lafeuillee BDD ne sont pas dans les deux périodes de la feuillle Absence. On pourrait penser que celle du 2/05/2020 y est mais quand tu compares la date du 02/05/2020 et l'horodate du 02/05/2020 11:32 , cette dernière est postérieure à la précédente qui est supposée être, en horodate 02/05/2020 00:00
Moralité: il est dangereux de mélanger dates et horodates si on veut faire des comparaisons.
la ligne où se situe des chiffres (qu'est-ce que c'est?)
des repères de travail qui m'ont servi pour la mise au point de la macro. Tu peux les supprimer.
OK ?
Bye !
Salut Nextia,
Salut gmb,
toutes les données étant déjà en ta possession, j'espère qu'on ne m'accusera pas de flicage...
Code à coller dans le module VBA 'ThisWorkbook' après avoir modifié (corrigé) les noms d'onglets : 'BDD' et 'Absence salariés'.
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
'
Dim iRow%, iOK%
'
Application.EnableEvents = False
'
iRow = Target.Row
Select Case Sh.Name
Case "BDD"
If Not Intersect(Target, Sh.Columns(15)) Is Nothing Then _
If Sh.Range("C" & iRow).Value <> "" And IsDate(Sh.Range("O" & iRow).Value) Then iOK = 1
Case "Absence salariés"
If Not Intersect(Target, Sh.Columns("K:L")) Is Nothing Then _
If Sh.Range("B" & iRow).Value <> "" And IsDate(Sh.Range("K" & iRow).Value) And IsDate(Sh.Range("L" & iRow).Value) Then iOK = 2
End Select
If iOK > 0 Then
With Worksheets(IIf(iOK = 1, "Absence salariés", "BDD"))
Select Case iOK
Case 1
'Sh = BDD
Sh.Range("AF" & iRow).Value = ""
Set rCel = .Columns(2).Find(what:=Sh.Range("C" & iRow).Value, lookat:=xlWhole, LookIn:=xlValues, searchdirection:=xlNext)
If Not rCel Is Nothing Then
For x = rCel.Row To .Range("B" & Columns.Count).End(xlUp).Row
If Sh.Range("C" & iRow).Value = .Range("B" & x).Value And _
DateValue(Sh.Range("O" & iRow).Value) >= DateValue(.Range("K" & x).Value) And _
DateValue(Sh.Range("O" & iRow).Value) <= DateValue(.Range("L" & x).Value) Then _
Sh.Range("AF" & iRow).Value = "OUI"
Next
End If
Case 2
'Sh = Absence
Set rCel = .Columns(3).Find(what:=Sh.Range("B" & iRow).Value, lookat:=xlWhole, LookIn:=xlValues, searchdirection:=xlNext)
If Not rCel Is Nothing Then
For x = rCel.Row To .Range("C" & Columns.Count).End(xlUp).Row
If Sh.Range("B" & iRow).Value = .Range("C" & x).Value And _
DateValue(Sh.Range("K" & iRow).Value) <= DateValue(.Range("O" & x).Value) And _
DateValue(Sh.Range("L" & iRow).Value) >= DateValue(.Range("O" & x).Value) Then _
.Range("AF" & x).Value = "OUI"
Next
End If
End Select
End With
End If
'
Application.EnableEvents = True
'
End Sub
A+
Bonjour GMB,
Top merci GMB, effectivement, je n'ai pas copié avec le format des fichiers d'origines, donc c'est de ma faute mais je te remercie encore pour ta remarque car elle me permet de mieux comprendre l'erreur. J'ai pris une autre date et cela fonctionne, j'ai hâte d'essayer avec 9000 lignes ahah on va voir si la bête tient le coup.
Un conseil à me donner quand j'aurais mis énormément de lignes(ça dépasse pas les 7-9K de lignes pour chaque onglet?
bonjour Curilis,
Merci pour ton retour, je réponds rapidement (je ne suis pas devant mon pc), qu'apporte comme modification ta macro?
Merci à vous deux!
Bonjour
Bonjour à tous
Un conseil à me donner quand j'aurais mis énormément de lignes ?
Non mais une demande. J'ai optimisé la macro en utilisant des variables tableau (d'où les chiffres que tu as pu voir). J'aimerais avoir un retour sur le temps de réponse. Est-ce supportable ?
Merci .
Bye !
Bonjour GMB,
J'ai tenté avec mes 20K de lignes et il semblerait que cela ne donne aucun résultat alors que pour certains matricules j'ai observé qu'ils avaient bien consommé.
Malheureusement le fichier fait 13mo, comment puis-je te transmettre le fichier?
Bonjour Curulis,
J'ai copié ta macro mais rien ne se passe et même pb je ne peux pas envoyer le fichier car il fait 13mo
Bonjour
Effectivement, 13 Mo, ça fait beaucoup.
Essaie en mettant le fichier dans un dossier compressé ou en supprimant des lignes...
Bye !
Salut Nextia,
Salut gmb,
rien ne se passera tant que tu n'inscris pas une nouvelle consommation ou une nouvelle période de maladie...
Je n'ai rien développé pour lire toute la BDD d'un coup : je vais le faire maintenant !
A+
c'est bizarre, même en diminuant de moitié, le fichier est toujours aussi gros
je test de le créer sur une autre fichier excel, sans macro et en mettant 50% des éléments
jai réussi à le mettre, j'ai dû retirer la macro, il y a toute l'exhaustivité
Pour rappel, se baser uniquement sur le Matricule et début et fin de période.
J'ai modifié les noms des onglets (BDD et absence salariés)
Cette modification a été faite après avoir fait le test de ta macro GMB
Jamais été aussi distrait par les éléments extérieurs...
Ceci peut fonctionner au coup par coup, que ce soit en 'BDD' ou 'Absence salariés'...
À coller dans 'ThisWorkbook
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
'
Dim sWkBDD As Worksheet, sWkABS As Worksheet
Dim iOK%, lgRow&, lgRow1&, lgRow2&, lgMat&
'
Application.EnableEvents = False
Application.ScreenUpdating = False
Set sWkBDD = Worksheets("BDD")
Set sWkABS = Worksheets("Absence salariés")
'
lgRow = Target.Row
Select Case Sh.Name
Case "BDD"
If Not Intersect(Target, Sh.Columns("O")) Is Nothing Then _
If Sh.Range("C" & lgRow).Value <> "" And IsDate(Sh.Range("O" & lgRow).Value) Then _
iOK = 1: _
lgMat = Range("C" & lgRow).Value
Case "Absence salariés"
If Not Intersect(Target, Sh.Columns("K:L")) Is Nothing Then _
If Sh.Range("B" & lgRow).Value <> "" And IsDate(Sh.Range("K" & lgRow).Value) And IsDate(Sh.Range("L" & lgRow).Value) Then _
iOK = 1: _
lgMat = Range("B" & lgRow).Value
End Select
'
On Error Resume Next
If iOK = 1 Then
With sWkBDD
.Range("A1:AF" & .Range("C" & Rows.Count).End(xlUp).Row).Sort _
key1:=.[C2], order1:=xlAscending, _
key2:=.[O2], order2:=xlAscending, _
Orientation:=xlTopToBottom, Header:=xlYes
lgRow1 = .Columns(3).Find(what:=lgMat, lookat:=xlWhole, LookIn:=xlValues, searchdirection:=xlNext).Row
End With
With sWkABS
.Range("A1:M" & .Range("B" & Rows.Count).End(xlUp).Row).Sort _
key1:=.[B2], order1:=xlAscending, _
key2:=.[K2], order2:=xlAscending, _
Orientation:=xlTopToBottom, Header:=xlYes
lgRow2 = .Columns(2).Find(what:=lgMat, lookat:=xlWhole, LookIn:=xlValues, searchdirection:=xlNext).Row
End With
MsgBox lgMat & " " & lgRow1 & " " & lgRow2
If lgRow1 > 0 And lgRow2 > 0 Then
With sWkBDD
Do While .Range("C" & lgRow1).Value = lgMat And .Range("O" & lgRow1).Value <> ""
lgRow = lgRow2
.Range("AF" & lgRow1).Value = ""
Do While sWkABS.Range("B" & lgRow).Value = lgMat
If DateValue(.Range("O" & lgRow1).Value) >= DateValue(sWkABS.Range("K" & lgRow).Value) And _
DateValue(.Range("O" & lgRow1).Value) <= DateValue(sWkABS.Range("L" & lgRow).Value) Then _
.Range("AF" & lgRow1).Value = "OUI": _
Exit Do
lgRow = lgRow + 1
Loop
lgRow1 = lgRow1 + 1
Loop
End With
End If
End If
'
Application.ScreenUpdating = True
Application.EnableEvents = True
'
End SubVivement cette nuit : seul !
A+
Bonjour GMB,
Merci bcp ça fonctionne, j'ai fait un sondage sur 10 matricules, c'est cohérent.
J'attends de recevoir les données des absences depuis février et je testerai si la macro fonctionne et ne refait pas comme la 1ère fois...
Je te tiens au courant
Bonjour Curulis57,
Merci pour ton retour, je test lorsque j'ai toutes les datas également pour voir si cela me donne le même résultat que GMB