nabilexcel2007
XLDnaute Occasionnel
Bonjour
ce code fonctionne bien mais parfois il décone je veux gérer les kilométrage de mes véhicule
je veux que chaque véhicule prend le dernier kilométrages retour comme début
Private Sub Worksheet_Change(ByVal Target As Range)
Dim wsVeh As Worksheet
Dim wsLoc As Worksheet
Dim mat As String
Dim lastKm As Variant
Dim ligne As Long
Set wsVeh = ThisWorkbook.Sheets("Vehicule") ' feuille Vehicule
Set wsLoc = Me ' feuille Location
' Vérifie si la modif est dans la colonne A (Mat)
If Not Intersect(Target, wsLoc.Range("A3:A1000")) Is Nothing Then
Application.EnableEvents = False
For Each cell In Target
If cell.Value <> "" Then
ligne = cell.Row
' Vérifie si Km départ est vide avant d'écrire
If wsLoc.Cells(ligne, "H").Value = "" Then
' Cherche le dernier Km retour de ce véhicule
lastKm = Application.Max(wsLoc.Range("I3:I" & ligne - 1).Cells _
.Parent.Evaluate("IF(A3:A" & ligne - 1 & "=""" & cell.Value & """,I3:I" & ligne - 1 & ")"))
If IsNumeric(lastKm) And lastKm > 0 Then
wsLoc.Cells(ligne, "H").Value = lastKm
Else
' Sinon prend le Km début de la feuille Vehicule
On Error Resume Next
wsLoc.Cells(ligne, "H").Value = Application.WorksheetFunction.VLookup(cell.Value, wsVeh.Range("A:C"), 3, False)
On Error GoTo 0
End If
End If
End If
Next cell
Application.EnableEvents = True
End If
End Sub
Merci
ce code fonctionne bien mais parfois il décone je veux gérer les kilométrage de mes véhicule
je veux que chaque véhicule prend le dernier kilométrages retour comme début
Private Sub Worksheet_Change(ByVal Target As Range)
Dim wsVeh As Worksheet
Dim wsLoc As Worksheet
Dim mat As String
Dim lastKm As Variant
Dim ligne As Long
Set wsVeh = ThisWorkbook.Sheets("Vehicule") ' feuille Vehicule
Set wsLoc = Me ' feuille Location
' Vérifie si la modif est dans la colonne A (Mat)
If Not Intersect(Target, wsLoc.Range("A3:A1000")) Is Nothing Then
Application.EnableEvents = False
For Each cell In Target
If cell.Value <> "" Then
ligne = cell.Row
' Vérifie si Km départ est vide avant d'écrire
If wsLoc.Cells(ligne, "H").Value = "" Then
' Cherche le dernier Km retour de ce véhicule
lastKm = Application.Max(wsLoc.Range("I3:I" & ligne - 1).Cells _
.Parent.Evaluate("IF(A3:A" & ligne - 1 & "=""" & cell.Value & """,I3:I" & ligne - 1 & ")"))
If IsNumeric(lastKm) And lastKm > 0 Then
wsLoc.Cells(ligne, "H").Value = lastKm
Else
' Sinon prend le Km début de la feuille Vehicule
On Error Resume Next
wsLoc.Cells(ligne, "H").Value = Application.WorksheetFunction.VLookup(cell.Value, wsVeh.Range("A:C"), 3, False)
On Error GoTo 0
End If
End If
End If
Next cell
Application.EnableEvents = True
End If
End Sub
Merci
