comparer des dates dans 2 feuilles (vba) et corriger les dates manquantes

[albert]

Bonjour à tous, forumiens, forumiennes,

Après comparaison des dates des feuilles 1 et 2, je cherche à remplir la colonne C de la feuille 1 avec les chiffres de la colonne B, feuille 2

Dans la feuille 1,colonne A, une série de dates qui servent de modèle.
Dans la feuille 2,colonne A, une série de dates incomplètes par rapport à celle de la feuille 1.

Pour chaque date de la feuille 1, je demande à vba d’aller chercher le chiffre correspondant dans la feuille 2, pour l’inscrire en feuille 1.
‘**********
‘**********
ma question : comment corriger la (ou les ) condition pour que la feuille 1 soit remplie correctement ?
‘**********

en feuille 1, colonne B j’ai indiqué les dates de la feuille 2, en laissant des cellules vide pour les dates manquantes.
Je demande à vba de remplir la colonne C
‘**********
If Cellule2 = Cellule1 Then
Cellule1.Offset(0, 2) = Cellule2.Offset(0, 1)

=> ce code s’arrête avant la première ligne vide, ce qui est logique.
Ensuite, la 2ème condition prend la main et remplit la cellule vide avec le chiffre de la veille dans la feuille 2 : 05/05/2006 => 231.69
(date manquante dans la feuille 2 - 08/05/2006):

If Cellule2 <> Cellule1 Then
Cellule1.Offset(0, 2) = Cellule2.Offset(-1, 1)

Ce qui donne
05/05/2006 231.69
08/05/2006 231.69
09/05/2006 232.49

jusque là, tout fonctionne.
Mais cette condition ne reprend pas la main lors de la prochaine date manquante en feuille 2 => 25/05/2006 et dans la feuille 1, la somme du 25/05/2006 correspond à celle du 26/05/2006 => 219.91
‘**********
j’ai essayé avec .Find(What:= RechDate) mais sans succès
'**********
Merci d’avance pour toute aide

albert

 

[suistrop]

Re : comparer des dates dans 2 feuilles (vba) et corriger les dates manquantes

salut,

Je suis nouveau en VBA donc je ne maitrise pas trop ta syntaxe j ai pas trop compris pkoi il y avais une erreur je crois ca viens du faite que ca se décalle quand y a 1 zone vide mais je suis pas sur ....


Je t es mis ma macro qui fais ce que tu demande .... enfin j espere , elle est longue on peut gagner du tps dans la boucle y mais je ne me suis pas penché dessus encore..... si c est vraiment trop long pour ce que tu as a traité je regarderais

Sub cartman()
'pour pas voir ce que fais excel
Application.ScreenUpdating = False
Sheets("Feuil1").Select
For i = 9 To Range("A65536").End(xlUp).Row
'present sert a vérifier si la date dans la feuille 2 est present dans le fichier 1 par défaut on dit que non
    present = False
    Sheets("Feuil1").Select
'date1 correspond a la date de la feuille 1 a la ligne i
    date1 = Cells(i, 1)
        Sheets("Feuil2").Select
        For y = 9 To Range("A65536").End(xlUp).Row
        Sheets("Feuil2").Select
        'pour chaque date de la feuille2 on va la comparer a la date1 celle de la ligne i de la feuille1
            date2 = Cells(y, 1)
        'on prend aussi le code de la feuille2
            code = Cells(y, 2)
            If date1 = date2 Then
            'si les 2 date sont simmilaire on va faire afficher la date et le code dans la feuille1
                Sheets("Feuil1").Select
                Cells(i, 2) = date2
                Cells(i, 3) = code
                present = True
            End If
            'ici c est pour accéléré le code comme ta liste est trié si la date2 est sup a la dat1 on a plus besoinde vérifier donc on sort de la boucle
            If date2 > date1 Then
                Sheets("Feuil2").Select
                y = Range("A65536").End(xlUp).Row
            End If
        Next y
        'une fois qu on a vérifié toute les date de la feuille2 di on est pas passé par dat1=date2 present est tjs faux
        'ca veut dire que la date est pas présente dans la feuille2 donc on va metre le code de la ligne du dessus
        If present = False Then
            Sheets("Feuil1").Select
            Cells(i, 3) = Cells(i - 1, 3)
        End If
Next i
'pour pas voir ce que fais excel
Application.ScreenUpdating = True
End Sub

Voila en esperant que ca te convienne !

 

[albert]

Re : comparer des dates dans 2 feuilles (vba) et corriger les dates manquantes

Bonsoir suistrop,
Moi non plus je ne comprend pas pourquoi il y a une erreur. J’ai bloqué toute la journée dessus.
Ton code est parfait. Heureusement que tu figes l’écran (1 mn) sinon en retirant ScreenUpdating on a le temps d’aller boire une bière au bistro d’en face.
Tu es nouveau en vba, pas mal pour un « débutant » moi je pensais être à l’aise, aujourd’hui j’ai déchanté.

J’étais aussi en train de chercher avec .Find
A tout hasard, tu as une idée de l’endroit où mettre la condition ?
Sub Macro1()
Columns("C:C").Select
Selection.ClearContents
Range("A1").Select
'------------------
For Each Feuille In Sheets

For i = 9 To Range("A9").End(xlDown).Row
Date_Rech = Cells(i, 1).Value 'date feuille 1
With Sheets(2).Range("A9:A562")

Indice = .Find(What:=Date_Rech). _
Offset(0, 1).Value
End With
Cells(i, 10).Value = Indice

Next

Next

End Sub

cordialement
albert

 

[skoobi]

Re : comparer des dates dans 2 feuilles (vba) et corriger les dates manquantes

Bonsoir suistrop, albert,

Si j'ai bien compris test ce code:

Sub test2()
Application.ScreenUpdating = False
For lig = 9 To Range("A9").End(xlDown).Row
  madate = Range("A" & lig).Value
  Set trouve = Sheets("Feuil2").Columns("A").Find(madate, LookIn:=xlValues, lookat:=xlWhole)
'si la date n'est pas trouvée
  If trouve Is Nothing Then
    Range("C" & lig).Value = Range("C" & lig - 1).Value
'sinon:
  Else: Range("C" & lig).Value = trouve.Offset(0, 1).Value
  End If
Next
Application.ScreenUpdating = True
End Sub

 

[albert]

Re : comparer des dates dans 2 feuilles (vba) et corriger les dates manquantes

Bonsoir skoobi,
« On en apprend tous les jours »
là, plus besoin de ScreenUpdating, la réponse est immédiate
‘***********
j’avais bien dans la tête d’utiliser « Set », mais après, blocage => il manquait Nothing
Is Nothing => voilà une instruction bien utile, je ne savais pas trop m’en servir (l’aide n’est pas très explicite sur ce sujet), elle correspond bien à la logique du raisonnement.

Merci pour ce code élégant
Et merci à suistrop, les différentes solutions sont toujours de bons éléments de progression

Bon week end

albert