Vba : Mettre en forme plage selon dates contenues dans 1 intervalle

[cibleo]

Bonsoir le forum,

J'aimerais revoir ce bloc d'instructions placé dans la macro du module1.
Pour comprendre, cliquez sur le bouton dans le fichier joint.

 .../...
'Ceci est à revoir, il faut parcourir tous les intervalles
With Sheets("VacancesScolaires")
DateFrom = .Range("A3") 'début des vacances
DateTo = .Range("B3") ' fin des vacances
End With
'La variable tableau contient les 7 dates de la feuille nouvellement créée
tableau = Sheets(Sheets.Count).Range("A4:A10")
For t = 1 To UBound(tableau)
' Si les dates contenues ds la variable Tableau sont comprises dans l'intervalle [DateFrom - DateTo]
If tableau(t, 1) >= DateFrom And tableau(t, 1) <= DateTo Then
'je colorie la plage de dates concernées dans la feuille nouvellement créée
Sheets(Sheets.Count).Range("A" & t + 3).Interior.ColorIndex = 43
End If
Next t
.../...

Des feuilles hebdomadaires sont crées avec leurs dates respectives.
Dans la feuille "VacancesScolaires" figurent les périodes de vacances scolaires.

Pour chaque feuille créée, j'aimerais mettre en forme les plages de dates concernées par ces périodes de vacances scolaires.
Ici seule la première période (du 05 janvier au 18 janvier) est prise en compte.
Les plages sont bien coloriées (voir feuilles concernées)

Je ne vois pas comment définir les variables DateFrom et DateTo pour prendre en compte toutes les périodes.
Pouvez-vous m'aider à modifier mon code ?

Merci Cibleo

 

[Compte Supprimé 979]

Re : Vba : Mettre en forme plage selon dates contenues dans 1 intervalle

Salut Cibleo,

Que ton code à l'air compliqué pour si peu de chose
mais bon chacun son truc

sinon essaye cette modif. (absolument pas optimisé)

      'La variable tableau contient les 7 dates de la feuille nouvellement créée
      tableau = Sheets(Sheets.Count).Range("A4:A10")
      For t = 1 To UBound(tableau)
        For V = 3 To 10
          DateFrom = Sheets("VacancesScolaires").Range("A" & V)
          DateTo = Sheets("VacancesScolaires").Range("B" & V)
          ' Si les dates contenues ds la variable Tableau sont comprises dans l'intervalle [DateFrom - DateTo]
          If tableau(t, 1) >= DateFrom And tableau(t, 1) <= DateTo Then
            ' je colorie la plage de dates concernées dans la feuille nouvellement créée
            Sheets(Sheets.Count).Range("A" & t + 3).Interior.ColorIndex = 43
            Exit For  ' Sort de l boucle des vacances
          End If
        Next V
      Next t

Nota : l'utilisation de tableau ralentit souvent le code, contrairement à ce que certains peuvent penser

A+

 

[JCGL]

Re : Vba : Mettre en forme plage selon dates contenues dans 1 intervalle

Bonjour à tous,

Pourquoi pas une Mefc sur la feuille "Modele" :



et



A+ à tous

 

[cibleo]

Bonsoir Bruno, JCGL

J'ai beaucoup de lacunes notamment les variables tableaux, j'en vois et j'en mets partout en ce moment.

Bruno, c'est parfait, j'ai testé.

JCGL : C'est vrai, pourquoi faire simple quand on peut faire compliqué

Merci à vous deux
Cibleo

 

[Compte Supprimé 979]

Re : Vba : Mettre en forme plage selon dates contenues dans 1 intervalle

Salut Cibleo,

Juste pour exemple, ma femme ma rapporté dernièrement un code qu'une collègue avait fait
Un comparatif du contenu de 2 dossiers, avec des variables tableaux
Pour ma femme ce n'était pas possible d'exploiter cet outil car cela mettait plus de 10 minutes à traiter les dossiers

Lorsque j'ai vu le code, j'ai eu mal à la tête tout de suite
Plus de 30 ou 40 lignes, des tableaux en veux-tu en voilà ...
Bref, j'ai dit à ma femme que l'on pouvait faire beaucoup, mais alors beaucoup plus simple ...

Mon code : 10-15 lignes / 1 minute de traitement

Je pense que tout est résumé

A+

 

[cibleo]

Re : Vba : Mettre en forme plage selon dates contenues dans 1 intervalle

Bonsoir le forum,

Une autre façon de procéder :
Une fonction personnalisée que Habitude m'a transmis :

Function EstVacance(pdate) As Boolean
Dim cell As Range
With Sheets("VacancesScolaires")
For Each cell In .Range("A3").Resize(.Range("A3").End(xlDown).Row - 2, 1)
If pdate >= cell.Value And pdate <= cell.Offset(, 1) Then
EstVacance = True
Exit Function
End If
Next cell
End With
EstVacance = False
End Function

Ici l'appel de la fonction :

.../...
j = 1
For Lig = 4 To 10
Sheets(Sheets.Count).Range("A" & Lig) = tablo1(i, j)
j = j + 1
Next Lig
'La variable tableau contient les 7 dates de la feuille nouvellement créée
tableau = Sheets(Sheets.Count).Range("A4:A10")
For t = 1 To UBound(tableau)
' Si les dates contenues ds la variable Tableau sont comprises dans l'intervalle 
If EstVacance(tableau(t, 1)) Then
'je colorie la plage de dates concernées dans la feuille nouvellement créée
Sheets(Sheets.Count).Range("A" & t + 3).Interior.ColorIndex = 43
End If
Next t
.../...

Merci Habitude