Planning - Application.Match et Application.Index

[Regueiro]

Bonsoir le Forum
Dans mon fichier ci-joint, sur la feuille " PLANNING 1"
Lorsque j'appuie sur le bouton 1
La procédure me remplit automatiquement le Planning.
Avec application.Match il me copie les couleurs selon la BDD.
Mais j'ai un problème de décalage.
Merci de votre Aide.

Sub CréerPlanning()
Dim Planning As Range, cell As Range
Dim DateFin As Range, compte&

Set Planning = Range("Planning")
For Each cell In Planning
If Cells(cell.Row, 3).Value <= Cells(4, cell.Column).Value _
And Cells(cell.Row, 5).Value >= Cells(4, cell.Column).Value _
Then
Application.ScreenUpdating = False

'cell.Interior.ColorIndex = 4
p = Application.Match(Cells(cell.Row, 1), Application.Index(Sheets("BDD").[CodeCouleur], , 2), 0)
If IsError(p) Then
Range("CodeCouleur").Offset(, 1).Copy
cell.PasteSpecial (xlPasteFormats)
Application.CutCopyMode = False


End If
End If

Next cell

Application.ScreenUpdating = True

End Sub

 

[mapomme]

Re : Planning - Application.Match et Application.Index

Bonsoir Regueiro,

Voir essai dans fichier joint.

 

[Bebere]

Re : Planning - Application.Match et Application.Index

bonjour Regueirro,ma pomme
pas besoin de index ni de copier/coller

 

[mapomme]

Re : Planning - Application.Match et Application.Index

Bonjour Regueirro, Bebere 🙂

[...] pas besoin de index ni de copier/coller [...]

Je crois bien que j'en ai utilisé aucun des deux 😕

 

[Regueiro]

Re : Planning - Application.Match et Application.Index

Bonsoir Le Forum, Mapomme et Bebere.
Mapomme, merci pour ton code il marche parfaitement.
Je l'ai essayé hier soir, par contre si je veux récupérer une image ou une couleur qui
N'est pas comprise dans interior.colorindex cela ne fonctionne pas.
C'est pourquoi j'avais tenté avec une application.match et index.
Bebere, j'ai pas testé ton code car je suis sur mon Ipad.
Je regarde cela tout à l'heure.
Merci encore.
À+

 

[mapomme]

Re : Planning - Application.Match et Application.Index

Bonsoir , à tous,

[...] par contre si je veux récupérer une image ou une couleur qui
N'est pas comprise dans interior.colorindex cela ne fonctionne pas. [...]

Je ne comprends pas 😕 Je n'utilise pas Color.Index ci ce n'est pour remettre à vide le fond des cellules avant de leur appliquer la couleur de fond correspondant au code.

 

[Regueiro]

Re : Planning - Application.Match et Application.Index

Bonsoir à Tous
Voilà j'ai trouver une solution.
Je vous joint le fichier.
Nous avons ainsi 2 possibilités de coloriage des cellules.
1. on copie la cellule voisine avec le format.
2. on copie la cellule voisine qui comporte une photo (picture type 13 )
Merci encore.

 

[Regueiro]

Re : Planning - Application.Match et Application.Index

Bonsoir le Forum.
J'ai un petit problème de lenteur avec ma macro.
Utiliser le Bouton "Lance Gantt" pour remplir le Planning
La procédure dure environ 1 minutes sur mon PC.

Le Bouton "Efface Gantt" pour remettre à Zéro
Les 2 autres boutons ne fonctionne pas avec ce fichier.

Sub LanceGantt()
Dim Planning As Range, cell As Range
With Application
.ScreenUpdating = False
.EnableEvents = False

End With




Set Planning = Range("ZonePlanning")
For Each cell In Planning
If Cells(cell.Row, 3).Value <= Cells(8, cell.Column).Value _
And Cells(cell.Row, 5).Value >= Cells(8, cell.Column).Value _
Then
'Application.ScreenUpdating = False
Set p = Sheets("BDD").Range("A1:A20").Find(Cells(cell.Row, 1))
If Not IsError(p) Then cell.Interior.Color = p.Offset(, 1).Interior.Color
End If
Next cell
Call DatesMFC

[L6].Select

Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

Pourriez-vous essayer de votre côté et me tenir au courant.
Ou bien dois-je améliorer mon code ?
En PJ le Fichier
A+

 

[Compte Supprimé 979]

Re : Planning - Application.Match et Application.Index

Bonjour Regueiro,

Désolé, mais de mon côté ça met à peine 10s 😉

 

[ChTi160]

Re : Planning - Application.Match et Application.Index

Bonjour Regueiro
Bonjour le Fil
Bonjour le Forum

En pièce jointe une autre approche

Le Fichier : Regarde la pièce jointe PLANNING JRE V06.1.xlsm

Bonne fin de journée
Amicalement
Jean marie

 

[Regueiro]

Re : Planning - Application.Match et Application.Index

Bonsoir Le Forum, ChTi160
J'ai fait un essai avec ton fichier.
Toujours la même Lenteur, environ 15 secondes.
Je ne comprends plus rien, avant les macros s'exécutaient très rapidement.
Cela doit provenir de mon Pc ou Excel ?
Auriez-vous une solution ?
Merci
A+

 

[Compte Supprimé 979]

Re : Planning - Application.Match et Application.Index

Salut Regueiro

Et en mettant un

Application.Calculation = xlCalculationManual

en début de code
et

Application.Calculation = xlCalculationAutomatic

à la fin

A tester ?

A+

 

[Regueiro]

Re : Planning - Application.Match et Application.Index

Bonsoir Le Forum
BrunoM45
ChTi160.
J'ai essayé sur mon PC Prof.
La Macro s'exécute en 1 seconde.
Sur Mon PC Portable Privé toujours le même Problème.
J'ai également essayé la Macro de ChTi160, mais toujours le même problème.

Sub LanceGantt()
Dim Planning As Range, cell As Range
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With

Set Planning = Range("ZonePlanning")
For Each cell In Planning
If Cells(cell.Row, 3).Value <= Cells(8, cell.Column).Value _
And Cells(cell.Row, 5).Value >= Cells(8, cell.Column).Value _
Then
'Application.ScreenUpdating = False
Set p = Sheets("BDD").Range("A1:A20").Find(Cells(cell.Row, 1))
If Not IsError(p) Then cell.Interior.Color = p.Offset(, 1).Interior.Color
End If
Next cell
Call DatesMFC

[L6].Select

Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic

End Sub
Sub EffacerGantt()
With Range("ZonePlanning")
.Interior.Pattern = xlNone
End With
End Sub

Pourriez-vous m'aider svp.
Problème de configuration Excel ou autre ?
Merci.
A+

 

[eriiic]

Re : Planning - Application.Match et Application.Index

Bonjour,

sur mon PC : 2.61s dont 1.2s pour DatesMFC.
C'est vrai que ça parait long pour le peu à faire.
J'ai essayé d'améliorer DatesMFC en enlevant les .select et remplaçant les tests sur les chaines par des tests sur weekday() mais bof... Pas d'amélioration notable.

Si j'ai bien compris ton code là où tu pourrais gagner du temps je pense c'est sur :
Set p = Sheets("BDD").Range("A1:A20").Find(Cells(cell.Row, 1))
If Not IsError(p) Then cell.Interior.Color = p.Offset(, 1).Interior.Color
Tu le fais pour chaque cellule. Tu pourrais le charger en une fois au début dans un dictionary.

Et sur :
For Each cell In Planning
If Cells(cell.Row, 3).Value <= Cells(8, cell.Column).Value _
And Cells(cell.Row, 5).Value >= Cells(8, cell.Column).Value _
inutile de le faire sur les WE, puisque tu le refais ensuite. Teste weekday(ta_date) en plus.
Et si tu mets plusieurs tests dans le même if ils tous évalués. Tu peux les séparer en commençant par celui qui élimine le plus de cas.

Mais pourquoi n'essaies-tu pas d'en faire le maximum par des MFC classiques ? Pourquoi ce choix par macro ?

eric

 

[Regueiro]

Re : Planning - Application.Match et Application.Index

Bonjour Le Forum, Eriiiic
Merci pour tes remarques.
Pourrais-tu m'établir le code pour le dictionary.
Je ne maîtrise pas trop ce type de collection.
Et la suite également si tu as le temps.
Autrement je regarde ça ce Soir.
Merci Encore
A+