Bonjour,
Si j'ai bien compris ta demande, je te propose la solution suivante:
Il s'agit tout d'abord de charger un tableau à deux dimensions qui contiendra les données de l'onglet "Feuil1"
par exemple:
02/05/2004 5
03/05/2004 2
04/05/2004 1
05/05/2004 3
06/05/2004 1
07/05/2004 1
J'ai donc créé une fonction qui permet de charger les données depuis la procédure qui effectuera le traitement
Fonction de Chargement
Function ChargeTableau(Feuille As String, ZoneCellules As String) As Variant
Dim Tableau As Variant
Tableau = Sheets(Feuille).Range(ZoneCellules)
ChargeTableau = Tableau
End Function
L'appel depuis la procédure de traitement se fait comme suit:
Dim TB As Variant
TB = ChargeTableau("Feuil1", "A1:B64")
La procédure de traitement :
- Positionnement sur la cellule A1 de l'onglet Calendar
- On part ensuite en boucle du 01/01/2004 au 31/12/2004 (ou autres dates qui peuvent être passées par paramètres)
- On compare la date courante avec les dates contenues dans le tableau
- S'il n'y a pas de correspondance on écrit cette date dans la cellule active puis la valeur 0 dans la cellule immédiatement à droite (déplacement avec OFFSET(x,y))
- S'il y a correspondance on vérifie la valeur de la deuxième colonne du tableau et on écrit autant de fois la date courante et à droite comme ci-dessus la valeur 1.
De ce fait, tu obtiens ceci (échantillon du résultat):
08/10/2004 1
08/10/2004 1
08/10/2004 1
09/10/2004 1
10/10/2004 0
11/10/2004 0
12/10/2004 0
13/10/2004 0
14/10/2004 0
15/10/2004 0
16/10/2004 1
16/10/2004 1
16/10/2004 1
16/10/2004 1
16/10/2004 1
17/10/2004 0
18/10/2004 0
Code de la procédure de traitement (à modifier selon les besoins)
Sub Traitement()
Dim TB As Variant
Dim DD As Date 'Date début
Dim DF As Date 'Date Fin
Dim DateCourante As Date
Dim i As Long
Dim Trouve As Boolean
TB = ChargeTableau("Feuil1", "A1:B64")
Sheets("Calendar").Select
Range("A1").Select
DD = "01/01/2004"
DF = "31/12/2004"
For DateCourante = DD To DF
'Recherche si date présente dans le tableau
Trouve = False
For i = LBound(TB) To UBound(TB)
If DateCourante = TB(i, 1) Then
Trouve = True
Exit For
End If
Next i
If Trouve Then
For J = 1 To TB(i, 2)
ActiveCell.Value = DateCourante
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = 1
ActiveCell.Offset(1, -1).Select
Next J
Else
ActiveCell.Value = DateCourante
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = 0
ActiveCell.Offset(1, -1).Select
End If
Next DateCourante
End Sub
Bien cordialement et bon courage