Bonjour,
Je suis chargé de caler des activités.
Pour faire ces activités je dois respecter des tolérances de dates.
En fonction de la tolérance en découle les semaines où je peux effectuer ces activités.
Exemple :
Maintenance du moteur. Tolérances : du 11 mai 2015 au 2 août 2015.
Donc les semaines où je peux effectuer la maintenance du moteur sont : Sem20 ; Sem21 ; Sem22; .... ; et Sem31.
Actuellement je fais cette recherche de semaines "manuellement" (avec un calendrier). :s
Et j'aimerais donc que ce travail soit fais automatiquement par macro...
2ème choses :
Une fois que les semaines seront proposées par la macro (si possible), il y a encore un filtre a faire.
En effet, il faut non seulement respecter les tolérances mais aussi des semaines dédiées par rapport a un calendrier calé sur 8 semaines. Nous appellerons ce calendrier le calendrier calque.
Exemple :
Calendrier calque :
Sem1 : Visite armoire électrique (correspond à la semaine 01 du calendrier)
Sem2 : Maintenance des sécurités (semaine 02 du calendrier)
Sem3 : Contrôle protection (semaine 03 du calendrier)
Sem4 : Maintenance Moteur (semaine 04 du calendrier)
Sem5 : Maintenance Pompe (semaine 05 du calendrier)
Sem6 : Réglage (semaine 06 du calendrier)
Sem7 : Recherche défaut (semaine 07 du calendrier)
Sem8 : Contrôle des départs (semaine 08 du calendrier)
"et on recommence.."
Sem1 : visite armoire électrique (semaine 09 du calendrier)
(...) (semaine 10 du calendrier)
Donc pour mon moteur (suivant la feuille 2 du fichier excel) sont sélectionnées au final les semaines : Sem20 et Sem28.
J'ai essayé de faire un début de code, mais ça marche pas trop trop... :s
Sub Macro1()
'
' Macro1 Macro
'
'
Dim tolérancedébut As Date
Dim tolérancefin As Date
With Sheets("Feuil1")
tolérancedébut = .Range("D" & Target.Row)
tolérancefin = .Range("E" & Target.Row)
Dim Rng As Range, c As Range, firstAddress As String, Ws As Worksheet, Trouve As Boolean
Set Ws = Worksheets("Feuil2")
For Each Rng In Ws.Range("A2", Ws.Range("A" & Ws.Rows.Count).End(xlUp))
Trouve = False
With Worksheets("Feuil2").Range("B:B")
Set c = .Find(Rng, LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
If (.Range("A") >= tolérancedébut) And (Range("A") <= tolérancefin) Then
c = .Range("F")
End If
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With
Next Rng
End With
End Sub
Merci d'avance pour votre aide,
Tchio!