de l'agressivité?? ou ca??
maintenant.. relis bien ton post et imagine toi à notre place..
J'ai un problème dans la gestion de mon fichier "vacances".===> il existe donc un fichier.. quelque part....
Le problème est un problème de lenteur de calcul dû à des boucles dans mon VBA qui contraignent le tout. ==> il y a donc un code.. quelque part.. avec des boucles. (for ? while, loop..????)
Je n'arrive pas à penser à une autre solution donc je fais appel à votre génie ;-)===> tu devrais plutot aller sur un site de voyance
Je ne peux pas partager mon fichier donc je vais essayer d'être assez clair dans mes explications.==> bah moi. j'ai bien des fichiers qui traitent ce genre de problème.. mais la.. du coup. je peux pas non plus..
J'ai une liste de 50 employés qui ont droit à 6 semaines de vacances.==> ils en ont de la chance.. 6 semaines au lieu de 5....
Désolé de l'incompréhension.... Le sérieusement m'a paru agressif.
Et oui je ne peux pas transmettre mon fichier comme ça et cela était plus simple pour moi d'expliquer plutôt que de recréer un fichier diffusable.
Et pour les vacances, c'est même 7 mais j'ai simplifié ma demande.
Belle annalogie mais ce n'est pas la même granularité.
Et sinon j'utilisais que des bouscles While défini par le nombre de ligne et de colonne concerné.
Merci de vos réponses et bonne journée.
Ci dessous le code similaire que j'utilise pour le même genre de tâche mais pour 2 semaines sans questions de priorité.
Sub TransferCures()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'On efface les données du tableau existant
Set JUMBO = Worksheets("Jumbo")
Set VACANCES = Worksheets("Holidays")
JUMBO.Range(Cure).ClearContents
JUMBO.Range(Cure).ClearComments
JUMBO.Range(Cure).Interior.Color = xlNone
JUMBO.Range(Cure).Borders(xlDiagonalUp).LineStyle = xlNone
JUMBO.Range(Cure).Borders(xlDiagonalDown).LineStyle = xlNone
'Activation de la page Vacances
VACANCES.Activate
'On défini l'année en cours
Année = Year(JUMBO.Cells(2, 2))
'Definition des différents numéro de colonne.
Col_Initiale = Application.Match("Initiales", Range(Titre), 0)
Col_Cure = Application.Match("Cure", Range(Titre), 0)
Col_SPVR_Start = Application.Match("SPVR Start Date", Range(Titre), 0)
Col_SPVR_End = Application.Match("SPVR End Date", Range(Titre), 0)
Col_CDQ_Start = Application.Match("CDQ Start Date", Range(Titre), 0)
Col_CDQ_End = Application.Match("CDQ End Date", Range(Titre), 0)
'Compte le nombre de nom d'ATCO dans la colonne "Initiales"
'Definition du début des lignes à tranférer sur la base de 140 ATCOS
Ligne_Debut = 4 'Ligne correspondant au 1er nom ATCO
Nombre_ATCO = WorksheetFunction.CountA(Range(Cells(Ligne_Debut, Col_Initiale), Cells(141, Col_Initiale)))
Ligne_Fin = Ligne_Debut + Nombre_ATCO - 1 '-1 car on commence à la Ligne_Debut
'Definition du début et de la fin du tableau sur l'onglet "JUMBO"
Col_Annuel_Vacances = 2 'Colonne "Semaine N°"
Col_Annuel_Debut = 3 'Colonne "Semaine 1" de l'année
Col_Cure_Debut = Col_Annuel_Debut
Col_Annuel_Fin = Col_Annuel_Debut + 53 '52+1 semaines dont la 1ere colonne donc 52
Col_Num_Semaine = Col_Annuel_Debut 'Semaine 1 commence à Col_Annuel_Debut
'Initialisation des variables d'incrément pour chaque boucle
Col_Annuel_Increment = Col_Annuel_Debut
Col_Cure_Increment = Col_Cure_Debut
While Col_Annuel_Increment <= Col_Annuel_Fin
'Définition de la 1ère ligne à sélectionner dans onglet "Vacances"
Ligne_Increment = Ligne_Debut
'Définition de la couleur de vacances sélectionnées
Col_Couleur = Col_Cure
While Ligne_Increment <= Ligne_Fin
i = 0
If Cells(Ligne_Increment, Col_Couleur + i) = 0 Then
ElseIf Cells(Ligne_Increment, Col_Couleur + i) = JUMBO.Cells(Ligne_Annuel_Vacances, Col_Annuel_Increment) Then
While i <= Nb_Cure
'On regarde si CURES posées = numéro de semaine
Initiale = Cells(Ligne_Increment, Col_Initiale)
Col_Num_Semaine = Application.Match(VACANCES.Cells(Ligne_Increment, Col_Couleur + i), JUMBO.Range(NumSem), 0) + (Col_Annuel_Debut - 1) 'Car on commence à Col_Annuel_Debut dans le tableau "Annuel"
Ligne_Cure_Increment = Ligne_Cure_Debut
Couleur_Vac_Pas_Compte = VACANCES.Cells(Ligne_Increment, Col_Couleur + i).Interior.Color
While Ligne_Cure_Increment >= Ligne_Cure_Fin
If JUMBO.Cells(Ligne_Cure_Increment, Col_Num_Semaine) = 0 Then
JUMBO.Cells(Ligne_Cure_Increment, Col_Num_Semaine) = Initiale
JUMBO.Cells(Ligne_Cure_Increment, Col_Num_Semaine).Interior.Color = Cells(Ligne_Debut - 1, Col_Couleur).Interior.Color
If VACANCES.Cells(Ligne_Increment, Col_SPVR_Start) = 0 Or Year(VACANCES.Cells(Ligne_Increment, Col_SPVR_End)) < Année Then
JUMBO.Cells(Ligne_Cure_Increment, Col_Num_Semaine).Font.ColorIndex = 0 'Pas SPVR
ElseIf Year(VACANCES.Cells(Ligne_Increment, Col_SPVR_End)) >= Année Then
JUMBO.Cells(Ligne_Cure_Increment, Col_Num_Semaine).Font.ColorIndex = 2 'SPVR/CDQ en cours
End If
If Couleur_Vac_Pas_Compte <> RGB(255, 255, 255) Then
JUMBO.Cells(Ligne_Cure_Increment, Col_Num_Semaine).Borders(xlDiagonalUp).LineStyle = xlContinuous
JUMBO.Cells(Ligne_Cure_Increment, Col_Num_Semaine).Borders(xlDiagonalUp).Weight = xlThin
JUMBO.Cells(Ligne_Cure_Increment, Col_Num_Semaine).Borders(xlDiagonalUp).ColorIndex = 1
JUMBO.Cells(Ligne_Cure_Increment, Col_Num_Semaine).Borders(xlDiagonalDown).LineStyle = xlContinuous
JUMBO.Cells(Ligne_Cure_Increment, Col_Num_Semaine).Borders(xlDiagonalDown).Weight = xlThin
JUMBO.Cells(Ligne_Cure_Increment, Col_Num_Semaine).Borders(xlDiagonalDown).ColorIndex = 1
End If
Ligne_Cure_Increment = 0
Else
'On passe à la ligne d'avant
Ligne_Cure_Increment = Ligne_Cure_Increment - 1
End If
Wend
'On passe à la colonne d'après
i = i + 1
If VACANCES.Cells(Ligne_Increment, Col_Couleur + i) = 0 And i <= Nb_Cure Then
i = Nb_Cure + 1
End If
Wend
End If
'On passe à la ligne d'après
Ligne_Increment = Ligne_Increment + 1
Wend
Col_Annuel_Increment = Col_Annuel_Increment + 1
Wend
End Sub
,
