Discussion :

[SamDag]

Bonjour,

Je débute dans la programmation Excel et j'essaie de résoudre ce problème à l'aide de VBA.

Tout est expliqué dans le fichier ci-joint.

Sachant que les données des colonnes A et B et le nombre des lignes ne sont toujours pas les mêmes, je voudrais calculer l'écart entre les "dates" d'occurrence (colonne B) d'un même "évènement" (colonne A) et pour toutes lignes et tous les évènements.

Merci d'avance pour votre aide.

[ARTURO83]

Bonjour,

Ceci:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
Sub Calcul_Ecart()
    'Déclaration des variables
    Dim DerLig As Long, i As Long, Ecart As Long, Deb As Long
    Dim x As Range
    Dim Evenement As String
    Dim Date_Even As Date
 
    Application.ScreenUpdating = False 'Evite le scintillement de l'écran et augmente la vitesse d'xécution
    Range("C2:C10000").ClearContents ' efface les derniers résultats
    DerLig = Range("A" & Rows.Count).End(xlUp).Row 'trouve la dernière ligne
    For i = 2 To DerLig - 1 'recherche de la ligne 2 jusqu'à la dernière
        Evenement = Cells(i, "A") 'évènement traité
        Date_Even = Cells(i, "B") 'date de l'évènement traitée
        Ecart = Cells(i, "C") 'écart enregistré à cette date
        With Range(Cells(i + 1, "A"), Cells(DerLig, "A")) 'de la plage A2 à la dernière cellule de la colonne A
            Set x = .Find(Evenement, lookat:=xlWhole) 'recherche de l'évènement
            If Not x Is Nothing Then 'si l'évènement est trouvé
                Deb = x.Row 'mémorise la ligne trouvée
                Do
                    If Ecart = 0 Then Cells(x.Row, "C") = Cells(x.Row, "B") - Date_Even 'si l'ecart est=0 alors on calcule les écarts
                    Date_Even = Cells(x.Row, "B") 'mémorisation de la nouvelle date trouvée
                    Set x = .FindNext(x) 'recherche de l'évènement suivant
                Loop While Not x Is Nothing And x.Row > Deb 's'il existe et s'il se trouve après le dernier évènement trouvé, alors on continu la recherche sinon on passe au suivant
            End If
        End With
    Next i
    Set x = Nothing 'libbère la mémoire
End Sub

Le fichier
Pièce jointe 591205

Cdlt