Untitled

 avatar
unknown
plain_text
10 months ago
2.2 kB
14
Indexable
Public Sub RechercherMatricule()
    Dim wsData As Worksheet, wsRecherche As Worksheet
    Dim lastRow As Long, i As Long, targetRow As Long
    Dim mat As String
    Dim jours As Long, totalRot As Double, totalA As Double, totalB As Double
    Dim d As Variant, setDays As Object, key As String
    
    On Error GoTo fail
    
    Set wsData = Sheets("Feuil1")
    Set wsRecherche = Sheets("Feuil5")
    
    mat = Trim(wsRecherche.Range("B1").Value)
    If mat = "" Then
        MsgBox "Entrez un matricule en B1.", vbExclamation
        Exit Sub
    End If
    
    lastRow = wsData.Cells(wsData.Rows.Count, 1).End(xlUp).Row
    Set setDays = CreateObject("Scripting.Dictionary")
    
    For i = 2 To lastRow
        If NzS(wsData.Cells(i, 2).Value) = mat Then
            d = wsData.Cells(i, 1).Value
            If Not IsDate(d) Then d = CDate(d)
            
            key = Format(CDate(d), "yyyy-mm-dd")
            If Not setDays.Exists(key) Then setDays.Add key, True
            
            totalRot = totalRot + NzD(wsData.Cells(i, 3).Value)
            totalA = totalA + NzD(wsData.Cells(i, 4).Value)
            totalB = totalB + NzD(wsData.Cells(i, 5).Value)
        End If
    Next i
    
    jours = setDays.Count
    
    ' --- Chercher si le matricule existe déjà dans la feuille de résultats
    targetRow = 0
    Dim searchLast As Long
    searchLast = wsRecherche.Cells(wsRecherche.Rows.Count, 1).End(xlUp).Row
    
    For i = 4 To searchLast
        If wsRecherche.Cells(i, 1).Value = mat Then
            targetRow = i
            Exit For
        End If
    Next i
    
    ' --- Si trouvé → update, sinon → ajouter à la fin
    If targetRow = 0 Then
        targetRow = searchLast + 1
    End If
    
    wsRecherche.Cells(targetRow, 1).Value = mat
    wsRecherche.Cells(targetRow, 2).Value = jours
    wsRecherche.Cells(targetRow, 3).Value = totalRot
    wsRecherche.Cells(targetRow, 4).Value = totalA
    wsRecherche.Cells(targetRow, 5).Value = totalB
    
    MsgBox "Recherche terminée ✅ (ligne " & targetRow & ")", vbInformation
    Exit Sub
    
fail:
    MsgBox "Erreur: " & Err.Description, vbCritical
End Sub
Editor is loading...
Leave a Comment