Rechercher plusieurs éléments communs sur deux onglets

Fausse alerte...il s'agissait d'un problème d'absence de matricules au titre du mois de 02/2022 donc la macro ne pouvait lire ce qui n'existait pas... LOL

Salut Nextia,

euh, comment veux-tu que je sache... sans fichier !?

Edit:
dans chaque feuille du fichier, le Range retenu dépend de la hauteur de la colonne contenant le n° Matricule.
Regarde si cette colonne est bien complète!

A+

Hey curilis!!! ravi que tu sois le premier à me répondre ! j'espère que tu te portes bien ! ::)

Le format du fichier "BDD" a été modifié (en terme d'ordre des colonnes), est-il possible s'il te plaît d'adapter la MACRO à ce nouveau format? Même règles/mêmes buts; je te joins le fichier. En voulant faire des copiers collers, je m'aperçois que sur certaines lignes au vu de la masse et des cellules vides --> source d'erreurs

merci beaucoup

Salut Nextia,

pour confirmation, dans 'BDD' actuelle :
- le n° matricule = Colonne [D:D] "Identifiant agent" ?
- jour de prise = Colonne [S:S] "Date/heure de la consommation" ?
- produit consommé = Colonne [Z:Z] "Produit consommé" ?

Dans ce cas, essaye ceci.

Private Sub cmdGO_Click()
'
Dim sWkABS As Worksheet
Dim tBDD, tABS, lgRow1&, lgRow2&
'
'On Error Resume Next
Set sWkABS = Worksheets("Absence salariés")
Application.EnableEvents = False
Application.ScreenUpdating = False
'
Call Tri(2)
T = Timer
lgRow1 = 1
tBDD = Range("A2:AG" & Range("C" & Rows.Count).End(xlUp).Row + 1).Value
tABS = sWkABS.Range("A2:O" & sWkABS.Range("B" & Rows.Count).End(xlUp).Row).Value
'
For x = 1 To UBound(tBDD, 1)
    If tBDD(x, 3) <> "" And tBDD(x, 15) <> "" Then
        For y = lgRow1 To UBound(tABS, 1)
            If CLng(tABS(y, 2)) = CLng(tBDD(x, 4)) Then
                lgRow2 = y
                If DateValue(tBDD(x, 19)) >= CDate(tABS(y, 11)) And DateValue(tBDD(x, 19)) <= CDate(tABS(y, 12)) Then
                    tBDD(x, 32) = "OUI"
                    tBDD(x, 33) = tABS(y, 10)
                    tABS(y, 15) = CInt(tABS(y, 15)) + 1
                    If DateValue(tBDD(x, 19)) = CDate(tABS(y, 12)) And tBDD(x, 26) = "Gazole" Then tBDD(x, 32) = "OUI  !"
                End If
                '
                If CLng(tABS(y + 1, 2)) <> CLng(tBDD(x, 4)) And lgRow2 > 0 Then
                    If CLng(tBDD(x + 1, 4)) <> CLng(tBDD(x, 4)) Then _
                        lgRow1 = lgRow2 + 1: _
                        lgRow2 = 0
                    Exit For
                End If
            End If
        Next
    End If
Next
Range("A2").Resize(UBound(tBDD, 1), UBound(tBDD, 2)).Value = tBDD
sWkABS.Range("A2").Resize(UBound(tABS, 1), UBound(tABS, 2)).Value = tABS
'MsgBox Timer - T
Columns("AF:AG").AutoFit
Me.cmdGO.Left = [AG1].Left + 2
'
Application.EnableEvents = True
Application.ScreenUpdating = True
'On Error GoTo 0
'
End Sub

A+

Je dois avoir loupé un truc, là...

- jour de prise = Colonne [S:S] "Date/heure de la consommation" ? NON; jour de prise c'est juste le jour de la consommation mais ce qui nous intéresse c'est bien la colonne S qu'il faut prendre (date et heure de conso)

A+

Lol...Je ne suis pas dans mon meilleur état ahah je viens de relire. Merci curilis

J'ai recopié la Macro dans le fichier joint, mais celle-ci m'indique ce code erreur :

Pas dans un meilleur état, moi, manifestement : je pensais avoir modifié toute la macro...

Private Sub cmdGO_Click()
'
Dim sWkABS As Worksheet
Dim tBDD, tABS, lgRow1&, lgRow2&
'
'On Error Resume Next
Set sWkABS = Worksheets("Absence salariés")
Application.EnableEvents = False
Application.ScreenUpdating = False
'
Call Tri(2)
T = Timer
lgRow1 = 1
tBDD = Range("A2:AG" & Range("D" & Rows.Count).End(xlUp).Row + 1).Value
tABS = sWkABS.Range("A2:O" & sWkABS.Range("B" & Rows.Count).End(xlUp).Row).Value
'
For x = 1 To UBound(tBDD, 1)
    If tBDD(x, 4) <> "" And tBDD(x, 19) <> "" Then
        For y = lgRow1 To UBound(tABS, 1)
            If CLng(tABS(y, 2)) = CLng(tBDD(x, 4)) Then
                lgRow2 = y
                If DateValue(tBDD(x, 19)) >= CDate(tABS(y, 11)) And DateValue(tBDD(x, 19)) <= CDate(tABS(y, 12)) Then
                    tBDD(x, 32) = "OUI"
                    tBDD(x, 33) = tABS(y, 10)
                    tABS(y, 15) = CInt(tABS(y, 15)) + 1
                    If DateValue(tBDD(x, 19)) = CDate(tABS(y, 12)) And tBDD(x, 26) = "Gazole" Then tBDD(x, 32) = "OUI  !"
                End If
                '
                If CLng(tABS(y + 1, 2)) <> CLng(tBDD(x, 4)) And lgRow2 > 0 Then
                    If CLng(tBDD(x + 1, 4)) <> CLng(tBDD(x, 4)) Then _
                        lgRow1 = lgRow2 + 1: _
                        lgRow2 = 0
                    Exit For
                End If
            End If
        Next
    End If
Next
Range("A2").Resize(UBound(tBDD, 1), UBound(tBDD, 2)).Value = tBDD
sWkABS.Range("A2").Resize(UBound(tABS, 1), UBound(tABS, 2)).Value = tABS
'MsgBox Timer - T
Columns("AF:AG").AutoFit
Me.cmdGO.Left = [AG1].Left + 2
'
Application.EnableEvents = True
Application.ScreenUpdating = True
'On Error GoTo 0
'
End Sub

Devrait être beaucoup mieux!

A+

Oui, mais, mi p'tite gueûye, quel est le nom de ton bouton de commande ?
Le code est-il collé dans le module de la feuille du bouton ?

Hé, je travaille à l'aveugle, ici...

Pardon Curilis, d'habitude, je mets toujours le fichier car autrement tu ne peux pas me guider... désolé voici le fichier sur lequel j'ai copié le code.

J'ai probablement fait une mauvaise manip...

Peux tu me le copier s'il te plaît si j'ai mal fait...sur la mauvaise feuille

Pas de souci, ici...

as tu une idée d'où viendrait le problème? merci beaucoup pour ta patience

Peut-être avec ton fichier de travail réel...

J'aimerais bien le partager avec toutes les lignes etc... mais le fichier dépasse les 4méga

Et bonjour au passage ;) et merci encore.

Faisons autrement, peux tu me fournir le fichier selon le format que je t'ai envoyé et d'y coller directement la MACRO. Comme ça, je n'aurais qu'à copier mes valeurs dans l'onglet BDD et absence salariés. Si après cela, cela ne fonctionne pas, je ne sais plus quoi faire...

Au pire Curilis, j'ai retiré le "bouton rouge" de manière à ce que je lance la macro sans passer par cela pour éviter d'avoir le problème du souci commande? qu'en penses tu, je la lancerai manuellement via le panneau de commande "MACRO" puis lecture... (c'est une hypothèse de solution)

Salut Nextia,

désolé pour tout ce stress, c'est moi qui ai oublié qu'il y avait des macros dans 'ThisWorkbook' et le 'Module1'...

Cela devrait être corrigé avec cette version-ci!
Si cela fonctionne comme cela devrait, j'ajouterai une fonction "Bordures".
Ce sont tes bordures préparées pour 11000 lignes qui te bouffaient l'espace!!

A+

je vais tester de suite. en revanche, j'ai remarqué que le moindre clic entraine un trie lorsque je souhaite coller l'information

erreur :