XL 2010 Ameliore une petite macro

creolia · 21 Septembre 2016

bonjour à tous

j'utilise cette macro depuis de nombreux mois sans aucun problème et tous fonctionne parfaitement.

mais je voudrais ajouter à l'importation de la ligne Pro une couleur de fond en meme temps que le nom on va dire bleu. comment ajouter cette petite option svp merci

Code:

Sub Maj_Dispo()
Dim TE(), LE As Long, CE As Long, TS(), LS As Long, CS As Long, TLC() As Long, FSource As Worksheet, FeuilTemp As String
FeuilSelect = Sheets("Dispo").Range("A6").Text
'MsgBox FeuilSelect
On Error Resume Next
FeuilTemp = Sheets(FeuilSelect).Range("P2")
' MsgBox FeuilTemp
Set FSource = ThisWorkbook.Sheets(FeuilTemp)

TE = Intersect(Application.Range(FSource.Rows(2), FSource.Rows(FSource.Rows.Count)), FSource.UsedRange).Value
ReDim TS(1 To UBound(TE, 1) \ 3 + 1, 1 To UBound(TE, 2) * 3 - 2)
ReDim TLC(1 To UBound(TS, 2))
For LE = 2 To UBound(TE, 1)
   For CE = 2 To UBound(TE, 2)
   On Error Resume Next
      Select Case TE(LE, CE)
     
             
         Case "M":   CS = CE * 3 - 5
         Case "A":   CS = CE * 3 - 4
         Case "N":   CS = CE * 3 - 3
         Case "Pro": CS = CE * 3 + (LE - 2) Mod 3 - 5
         Case Else:  CS = 0: End Select
        
      If CS > 0 Then
         LS = TLC(CS) + 1: TLC(CS) = LS
         TS(LS, CS) = TE(LE - (LE - 2) Mod 3, 35)
         End If: Next CE, LE
Sheets("Dispo").[B3].Resize(UBound(TS, 1), UBound(TS, 2)).Value = TS
'Trie.Triealpha
End Sub

si un fichier joint est obligatoire j’essaierais de le mettre car l'ensemble est déja trés lourd avec des donnés sensible merci à vous

Paf · 21 Septembre 2016

Bonjour,

un classeur joint est toujours un plus, notamment pour vérifier nos propositions....

Peut-être en rajoutant :

Code:

Sheets("Dispo").[B3].Resize(UBound(TS, 1), UBound(TS, 2)).Interior.ColorIndex = 5

après la ligne:

Code:

Sheets("Dispo").[B3].Resize(UBound(TS, 1), UBound(TS, 2)).Value = TS

A+

creolia · 21 Septembre 2016

Bonjour à toi paf en effet un fichier c'est mieux je vais essayer extraire tous sa ta sollution me colorie tous en bleu donc c'est pas bon je vais essayer de faire un fichier

creolia · 21 Septembre 2016

voila le petit fichier joint

Paf · 21 Septembre 2016

Re,

je voudrais ajouter à l'importation de la ligne Pro une couleur de fond en meme temps que le nom

sans avoir vu le classeur ( il vaut mieux l'anonymiser !!!) je ne voyais qu'une ligne d'écriture (Sheets("Dispo").[B3].....) et pensais que c'était cette écriture qu'il fallait mettre en couleur.

A regarder de plus près, tous les infos sont stockées dans un tableau (VS) puis collées sur la feuille en fin de traitement, on ne peut donc pas colorer la ligne voulue ( ligne Pro) à ce moment mais après le collage et après identification de la ligne en question.

La question est : comment repérer la ligne pro ?

A+

creolia · 21 Septembre 2016

Re j'ai encore essayer de comprendre mais j' y arrive pas quelqu'un pourait il m'aider svp merci

creolia · 21 Septembre 2016

Paf à dit:
Re,

sans avoir vu le classeur ( il vaut mieux l'anonymiser !!!) je ne voyais qu'une ligne d'écriture (Sheets("Dispo").[B3].....) et pensais que c'était cette écriture qu'il fallait mettre en couleur.

A regarder de plus près, tous les infos sont stockées dans un tableau (VS) puis collées sur la feuille en fin de traitement, on ne peut donc pas colorer la ligne voulue ( ligne Pro) à ce moment mais après le collage et après identification de la ligne en question.

La question est : comment repérer la ligne pro ?

A+

j'ai mis le fichier joint

Paf · 22 Septembre 2016

re,

creolia à dit:
Re j'ai encore essayer de comprendre mais j' y arrive pas quelqu'un pourait il m'aider svp merci

Savoir ce que fait ( ou est sensé faire) le code est primordial pour pouvoir y apporter des modifications. Mais comprendre les tableau en entrée et en sortie l'est tout autant.

Pouvez vous préciser à quoi correspondent les tableaux en feuilles BDD9 et Dispo ?

A+

creolia · 22 Septembre 2016

la BBD9 viens du site planning en ligne que l'on utilise pour nos disponibilités la macro importe les donnée et les traduit en disponibilité par jour et par période de la journée (M matin A apresmidi N nuit et Pro pompiers Pro.

Paf · 22 Septembre 2016

re,

En feuille Dispo:
- Je vois bien 3 colonnes par jour, à quoi correspondent-elles ?
- Comment sont (ou devraient être) réparties les 4 périodes (M,A,N,Pro) sur les 3 colonnes ?

En feuille BDD9 :
- à quoi correspondent les lignes grises sous chaque ligne blanche nominative ?
- on retrouve bien M,N,A (pour matin,nuit et aprèsmidi) et PRO, mais à quoi correspond CP, FOR,BIP (...) comment doivent ils être répartis dans la feuille Dispo ?

A+

creolia · 24 Septembre 2016

re bonjour
Dans Dispo
les 3 colonne representre M(Matin) A(apres midi) N(Nuit)

dans base de donne(BDD)
Le nom la ligne 1 représente matin
la ligne 2 apres midi
la ligne 3 Nuit
les lettres (M A N) sont les disponibilité des volontaire judicieusement placer sur la ligne correspondant via le programme de planning en ligne

Pro est placer sur la ligne correspondant: si il est du Matin le Pro seras sur la ligne matins i il est d' apres midi sur la ligne 2 ou Nuit sur la ligne 3

tout cela étant pas exploitable en l'état la macro importe et les classe dans Dispo par jour et periode de la journée

pour info CP FOR et BIP ne sont plus pris en compte par la direction on reste sur MAN et PRO

j'ai mis une image du planning en ligne

Paf · 24 Septembre 2016

Re,

un essai:

VB:

Sub Dispo()
Dim TE(), LE As Long, CE As Long, TS(), LS As Long, CS As Long, TLC() As Long, FSource As Worksheet
Dim DerL As Long
Sheets("Dispo").Range("B4:CP60").ClearContents
Set FSource = ThisWorkbook.Sheets("BDD9")

DerL = FSource.Range("A" & Rows.Count).End(xlUp).Row
TE = FSource.Range("A2:AH" & DerL) 'ligne  modifiée
ReDim TS(1 To UBound(TE, 1) \ 3 + 1, 1 To UBound(TE, 2) * 3 - 2)
ReDim TLC(1 To UBound(TS, 2))
For LE = 2 To UBound(TE, 1)
   For CE = 2 To UBound(TE, 2)
      Select Case TE(LE, CE)
         Case "M":   CS = CE * 3 - 5
         Case "A":   CS = CE * 3 - 4
         Case "N":   CS = CE * 3 - 3
         Case "Pro": CS = CE * 3 + (LE - 2) Mod 3 - 5 'And Range(LE).Interior.ColorIndex = 8
         Case "BIP": CS = CE * 3 + (LE - 2) Mod 3 - 5
         Case Else:  CS = 0: End Select
       
      If CS > 0 Then
         LS = TLC(CS) + 1: TLC(CS) = LS
         'ligne modifiée: insertion de "PRO" pour les individus Pro
         TS(LS, CS) = TE(LE - (LE - 2) Mod 3, 34) & IIf(TE(LE - (LE - 2) Mod 3, CE) = "Pro", " PRO", "")
         End If: Next CE, LE
Sheets("Dispo").[B4].Resize(UBound(TS, 1), UBound(TS, 2)).Value = TS

'** recherche des "PRO" et modif couleur et suppression de la mention "PRO"
For Each cel In Sheets("Dispo").Range("B4").CurrentRegion.SpecialCells(xlCellTypeConstants)
    If cel.Value Like "*PRO" Then
        cel.Interior.ColorIndex = 5
        cel.Font.ColorIndex = 2
        cel.Value = Left(cel.Value, Len(cel) - 4)
    End If
Next

MsgBox "Mise à Jour terminée avec succées cliquez sur (OK) pour continuer"

'Menu.Caption = "Menu"
'Unload Menu
End Sub

A+

creolia · 24 Septembre 2016

bonjour paf merci pour cette macro qui semble excelent sur le fichier d'essais je vais l'appliquer à mon fichier un grand merci deja pour ton travail malgre mes info pas toujours explicite

creolia · 30 Mars 2017

Bonjour paf je déterre mon post sur une macro que tu as fait pour moi après plusieurs mois de fonctionnement ou dans nos planning apparaissais quelque erreur incompréhensible (Les Pro se coloriaient et des fois pas) je me suis rendu compte en fait si un nom le matin il est pas en pro et que l’après-midi il était en garde pro la couleur ne s’appliquait pas comment pourrais je faire pour que les couleur s'applique au pro au bon moment de la journée svp merci

XL 2010 Ameliore une petite macro

creolia

XLDnaute Impliqué

Paf

XLDnaute Barbatruc

creolia

XLDnaute Impliqué

creolia

XLDnaute Impliqué

Pièces jointes

Paf

XLDnaute Barbatruc

creolia

XLDnaute Impliqué

creolia

XLDnaute Impliqué

Paf

XLDnaute Barbatruc

creolia

XLDnaute Impliqué

Paf

XLDnaute Barbatruc

creolia

XLDnaute Impliqué

Paf

XLDnaute Barbatruc

creolia

XLDnaute Impliqué

creolia

XLDnaute Impliqué

Pièces jointes

Discussions similaires