méthode Find en boucle pour ajouter des dates manquantes

[albert]

bonsoir à tous, bonsoir fourum,
c'est un plaisir chaque jour renouvelé que de rendre visite au forum... surtout après avoir "lutté" en vain pour trouver la solution... (qui se cache bien...)

Voilà....
Dans la pièce jointe,

Les dates de la feuille Reference sont complètes, elles sont comparées successivement avec les dates des feuilles AA et BB

Dans la feuille AA, il manque le 26/06
Dans la feuille BB, il manque le 07/07

(ce que le code doit trouver)

Le code compare correctement AA à la feuille référence et colore le 26/03

Mais ensuite, la feuille BB est comparée à la feuille AA (à la place de la feuille Référence)
(computer rebelle)
donc, j'ai deux pb à résoudre :

- Comment obtenir une comparaison successive de chaque feuille (AA,BB …) avec la feuille Référence ??

-Lorsque les dates manquantes sont trouvées par le code, comment obtenir qu’elles soient ajoutées à leur place, dans les feuilles AA et BB (pour complèter les colonnes)???

merci d'avance

albert

le code :
Sub Comparaison()
Application.ScreenUpdating = False
Dim Cellule1 As Range, Cellule2 As Range
Compteur = Sheets.Count - 1
For i = 1 To Compteur
With Sheets("Reference")
For Each Cellule1 In Range("P7", Range("P7").End(xlDown))
Sheets(i).Select
For Each Cellule2 In Range("P7", Range("P7").End(xlDown))
If Cellule1 <> Cellule2 Then
Cellule1.Font.Color = vbGreen
Else
Cellule1.Font.Color = vbBlack
Exit For
End If
Next Cellule2
Next Cellule1
Application.ScreenUpdating = True
End With
Next i
Sheets("Reference").Select
End Sub

 

[michel]

Bonsoir Albert

j'espère que la procédure ci joint répondra à ta demande


Sub Comparaison()
Dim Cellule1 As Range
Dim Cellule2 As Range
Dim i As Byte

Application.ScreenUpdating = False

For i = 1 To Sheets.Count
If Not Sheets(i).Name = "Reference" Then
For Each Cellule1 In Sheets("Reference").Range("P8", Range("P8").End(xlDown))

For Each Cellule2 In Sheets(i).Range("P8", Sheets(i).Range("P8").End(xlDown))
If Cellule1 = Cellule2 Then
Exit For
Else
If Cellule1 < Cellule2 Then
Sheets(i).Rows(Cellule2.Row).Insert Shift:=xlDown
Sheets(i).Cells(Cellule2.Row - 1, 16) = Cellule1
Exit For
End If
End If
Next Cellule2

Next Cellule1

End If
Next i

Application.ScreenUpdating = True

End Sub


bonne soirée
michel

 

[albert]

merci michel,
tu vas au-delà de ce que j'ai imaginé... tu complètes les dates manquantes!!

bon, j'ai cru que j'étais aussi un virtuose (on est vite remis à sa place...par Bill...). J'ai donc tenté de remplir les cases vides avec le chiffre de la veille :

- feuille BB copie Q20 dans Q21
- feuille AA copie Q11 dans Q12
J'ai essayé :
Sheets(i).Cells(Cellule2).Offset(-1, 1) = Sheets(i).Cells(Cellule2).Offset(0, 1)

ça ne marche pas... (et toutes les combinaisons échouent)


avec F8 le code ne donne pas le déroulement... je suis bien dans l'embarras...

Comment remplir ces cellules???

merci d'avance

albert

 

[Michel]

Bonjour Albert

Je ne suis pas sur d'avoir bien compris ta demande :
J'ai interprété qu'après avoir inséré une date manquante , il faut récupérer la valeur de la veille ( ligne precedente dans le meme tableau ) et l'insèrer dans la colonne de droite de la date


Sub Comparaison()
Dim Cellule1 As Range
Dim Cellule2 As Range
Dim i As Byte

Application.ScreenUpdating = False

For i = 1 To Sheets.Count
If Not Sheets(i).Name = "Reference" Then
For Each Cellule1 In Sheets("Reference").Range("P8", Range("P8").End(xlDown))

For Each Cellule2 In Sheets(i).Range("P8", Sheets(i).Range("P8").End(xlDown))
If Cellule1 = Cellule2 Then
Exit For
Else
If Cellule1 < Cellule2 Then
Sheets(i).Rows(Cellule2.Row).Insert Shift:=xlDown
Sheets(i).Cells(Cellule2.Row - 1, 16) = Cellule1
Sheets(i).Cells(Cellule2.Row - 1, 17) = Sheets(i).Cells(Cellule2.Row - 2, 17)
Exit For
End If
End If
Next Cellule2

Next Cellule1

End If
Next i

Application.ScreenUpdating = True

End Sub


bon aprés midi
Michel

 

[albert]

merci michel,


c'est exactement ce que je cherche à réaliser...
j'ai pataugé un moment sur ce sujet

je joins le fichier pour ceux qui seraient intéressés par le résultat

cordialement

albert

 

[albert]

.... et voilà l'travail...

merci pour tout, michel

albert