Planning - Application.Match et Application.Index

Regueiro · 15 Juin 2013

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 · 16 Juin 2013

Re : Planning - Application.Match et Application.Index

Bonsoir Regueiro,

Voir essai dans fichier joint.

Bebere · 16 Juin 2013

Re : Planning - Application.Match et Application.Index

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

mapomme · 16 Juin 2013

Re : Planning - Application.Match et Application.Index

Bonjour Regueirro, Bebere 🙂

Bebere à dit:
[...] pas besoin de index ni de copier/coller [...]

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

Regueiro · 16 Juin 2013

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 · 16 Juin 2013

Re : Planning - Application.Match et Application.Index

Bonsoir , à tous,

Regueiro à dit:
[...] 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 · 16 Juin 2013

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 · 22 Juin 2013

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 · 23 Juin 2013

Re : Planning - Application.Match et Application.Index

Bonjour Regueiro,

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

ChTi160 · 23 Juin 2013

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 · 23 Juin 2013

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 · 24 Juin 2013

Re : Planning - Application.Match et Application.Index

Salut Regueiro

Et en mettant un

Code:

Application.Calculation = xlCalculationManual

en début de code
et

Code:

Application.Calculation = xlCalculationAutomatic

à la fin

A tester ?

A+

Regueiro · 25 Juin 2013

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 · 26 Juin 2013

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 · 26 Juin 2013

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+

Planning - Application.Match et Application.Index

Regueiro

XLDnaute Impliqué

Pièces jointes

mapomme

XLDnaute Barbatruc

Pièces jointes

Bebere

XLDnaute Barbatruc

Pièces jointes

mapomme

XLDnaute Barbatruc

Regueiro

XLDnaute Impliqué

mapomme

XLDnaute Barbatruc

Regueiro

XLDnaute Impliqué

Pièces jointes

Regueiro

XLDnaute Impliqué

Pièces jointes

Compte Supprimé 979

Guest

ChTi160

XLDnaute Barbatruc

Regueiro

XLDnaute Impliqué

Compte Supprimé 979

Guest

Regueiro

XLDnaute Impliqué

Pièces jointes

eriiic

XLDnaute Barbatruc

Regueiro

XLDnaute Impliqué

Discussions similaires

Planning - Application.Match et Application.Index

XLDnaute Impliqué

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

XLDnaute Impliqué

XLDnaute Barbatruc

XLDnaute Impliqué

Pièces jointes

XLDnaute Impliqué

Pièces jointes

Compte Supprimé 979

Guest

XLDnaute Barbatruc

XLDnaute Impliqué

Compte Supprimé 979

Guest

XLDnaute Impliqué

Pièces jointes

XLDnaute Barbatruc

XLDnaute Impliqué

Discussions similaires

Privacy & Transparency

Privacy & Transparency