Untitled
unknown
plain_text
10 months ago
2.2 kB
15
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