VBA : concordance date

1 pièce(s) jointe(s)

Bonjour à tous et merci par avance de votre aide.

Mon objectif est celui ci : j'aimerais faire concorder les dates de mon fichier afin de faire des calculs de rendements, je m'explique :
Dans la colonne A et D il y a des dates triés dans l'ordre croissant.
La colonne B correspond au close(prix) pour la date de la colonne A
La colonne E correspond au close(prix) pour la date de la colonne D

Afin que mes calculs soient correct, il faut que les dates concordent, ainsi si dans la colonne A j'ai le 5 janvier et dans la colonne E le 11 janvier, mon calcul n'aura pas de sens, ces deux dates doivent concorder
Donc : A = 13 janvier et B = 13 janvier
Il faut donc effacer la date ainsi que le close de la date dite "inférieure"
J'ai donc crée ce code qui ne fonctionne pas
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 Sub synchronisation() For i = 1 To 65000 While Cells(1 + i, 2) <> Cells(1 + i, 4) If Cells(i, 2) < Cells(i, 4) Then Cells(i, 2).Delete& Cells(i, 3) Else If Cells(i, 2) > Cells(i, 4) Then Cells(i, 4).Delete& Cells(i, 3) End If i = i + 1 Wend Next End Sub
J'espère avoir été clair, dans le cas contraire je m'explique volontiers, je joins mon fichier en pièce jointe,

merci d'avance,

jean luc

PS : J'ajoute une image du rendu attendu car je n'arrive pas a joindre le fichier !
Il me dit : fichier non valide, c'est un fichier xlsm

A gauche de A a E le ficher de base et de G a K le rendu attendu !
En faite, cela doit effacer non seulement la date mais également le close en décalant les cellules vers le haut !
je pense que ce sera plus clair sur la photo :)

Merci

Bonjour,

Essaie comme cela

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub test()
Dim C As Range
Dim Derlig As Long, i As Long
    Derlig = Range("A" & Rows.Count).End(xlUp).Row
    For i = Derlig To 2 Step -1
        Set C = Columns(4).Find(Range("A" & i).Value, LookIn:=xlValues, lookat:=xlWhole)
        If C Is Nothing Then Range("A" & i).Resize(1, 2).Delete Shift:=xlUp
    Next i
    Derlig = Range("D" & Rows.Count).End(xlUp).Row
    For i = Derlig To 2 Step -1
        Set C = Columns(1).Find(Range("D" & i).Value, LookIn:=xlValues, lookat:=xlWhole)
        If C Is Nothing Then Range("D" & i).Resize(1, 2).Delete Shift:=xlUp
    Next i
End Sub

Cordialement.

Cela fonctionne merci beaucoup