Faut il un TCD ??
Bonjour à tous,
Voilà j'aimerai modifier l'agencement dans mon fichier et inversé les données et les entêtes de colonne pour une préparation avant impression!
ci joint un exemple de ce que j'aimerai obtenir.
Faut il passer par un TCD (que je ne maîtrise pas du tout) ou juste par du code vb ?
Si vous avez des idées pour réaliser quelques chose comme ca!
Une grosse inconnue dans mon tableau est le nombre d'horaire qui seront à rapatrier ( 3 dans mon exemple) ni le nombre d'agent ( qui varie selon les services) mais cela ne devrai pas changer grand chose
Merci pour vos idées ou solutions
Bonjour
Pour répondre à ta question : je ne sais pas.
Mais je te propose un essai à tester;
Te convient -il ?
Bye !
Ok merci gmb,
Effectivement ça répond à ma demande, je vais essayer de comprendre ton code, ( quelques bonnes nuits en perspective) mais si j'ai bien compris du stock dans "scripting dictionary" ( tableau virtuel?) puis après je me pers dans tes boucles .....
Si tu as du temps Je serais pas contre quelques explications ( car je vais devoir appliquer ça pour les 12 mois de l'années via filtration de ma feuille initiale)
Encore merci
ok super,
effectivement je vais pas être obliger de jouer les Champollion avec tes explications, trop fort ce genre de code va falloir que je me penche sur les tableaux et les dictionnaires ça à l air assez puissant!!
je valide pas encore si j'ai des questions subsidiaires !
Encore une fois merci pour la solution expliqué
Alors voilà effectivement j'ai des interrogations car mon exemple était peut êtres un peu trop simplifié....
Est - il possible d’insérer une colonne nommer RH entre chaque colonne? et est il possible d'ajouter dans la macro le calcule des rh en fonction de la date ( seulement samedi et dimanche même quand ils sont fériés ) j'ai déclarer samedi=6 dimanche=7 et les fériés =8 mais si je garde cette nomenclature les féries tombant un samedi ou un dimanche ne seront pas pris en compte!
sur mon ancien fichier, je faisais passer une macro pour calculer les rh d'apres une extration ( equivalente à ma liste actuelle filtré par ma combo feries)
Function Dimanche1()
Dim z, i As String
FWE
Cells(2, 1).Select
i = Range(Selection, Selection.End(xlDown)).Count
For z = 2 To i Step 2
WsFWE.Cells(z, 2).Select
ActiveCell.FormulaR1C1 = "=IF(RC[-1]="""","""",MONTH(RC[-1]))"
WsFWE.Cells(z + 1, 2).Select
ActiveCell.FormulaR1C1 = "=IF(RC[-1]="""","""",MONTH(RC[-1]))"
Cells(z, 3).Select
ActiveCell.FormulaR1C1 = "=RC[-2]-1"
Cells((z + 1), 3).Select
ActiveCell.FormulaR1C1 = "=RC[-2]+2"
Next z
End Function
Function Dimanche2()
Dim z, i As String
FWE
Dimanche1
Cells(2, 1).Select
i = Range(Selection, Selection.End(xlDown)).Count
For z = 2 To i Step 2
WsFWE.Cells(z, 2).Select
ActiveCell.FormulaR1C1 = "=IF(RC[-1]="""","""",MONTH(RC[-1]))"
WsFWE.Cells(z + 1, 2).Select
ActiveCell.FormulaR1C1 = "=IF(RC[-1]="""","""",MONTH(RC[-1]))"
Cells(z, 5).Select
ActiveCell.FormulaR1C1 = "=RC[-4]-2"
Cells((z + 1), 5).Select
ActiveCell.FormulaR1C1 = "=RC[-4]+2"
Next z
End Function
Function Dimanche3()
ect.........
La macro écrivait dans mes colonnes "rh" la formule qui permettait de calculer la date du RH. j'ai repris la répartition dans mon fichier exemple, onglet "prt". Et je n'avais décrit que 3 cas !Pour les cas ou il y aurai plus de 3 agent par week-end il faudrai revenir sur le roulement à 1 si j'ai 4, 2 si j'ai 5 ect.....
Mais ma formule ne vérifiait pas si la nouvelle date trouvée correspondait également à un férié. ( Les feriés sont déclaré sur la plage "Feries" de mon onglet prm)
Penses- tu que l'on peut faire d'une pierre deux coup et intercaler ceci sur la macro précédente??
Pour la repartition par mois je pensais d'apres ma liste filtre par ma combo "Feriés" un second fitrage par mois
For i = 1 To 12
WsPlan.Range("$C$1:$E$376").AutoFilter Field:=1, Criteria1:=i
'ici code permettant le copier coller de la selection du mois vers l'onget Prt avec nouvelle mise en forme ------> que tu viens de réalisé ....
next i
Si tu as des idées pour faire cela car là je vois pas par quel bout attaquer le problème
Je laisse mon fichier exemple, si tu as le temps de jeter un oeil dans les prochains jours ou si tu as des pistes à me faire suivre pour réaliser ceci en mois de 20 macros complètement indigeste! ( comme ce poste d'ailleurs)
dernier détail pour jouer avec les affichages onglets/ barre de menu etc... voir le bouton ruban/onglet dans le ruban
[Edit] va falloir que je m'achete des yeux pour les fautes d'orthographe!!
je vous fait une autre proposition
j'utilise la notion de tableau nommés, ce que fait que le tableau de départ peut être déplacer et la création de la nouvelle présentation est simplifiée
je me suis inspiré fortement de la solution de jmb, je ne connaissais pas la notion de dictionnaire qui est très utile
merci à jmb
si vous souhaiter des explications sur la notions de tableaux nommés je peux vous faire parvenir des fichiers d'explication
Merci gullaud pour cette réponse, je regarde ca rapidement !
gullaud a écrit :j'utilise la notion de tableau nommés, ce que fait que le tableau de départ peut être déplacer et la création de la nouvelle présentation est simplifiée
En fait, dès lors que les données sont sous forme de tableau, il n'est pas forcément utile de définir d'autres noms, on peut utilisr les en-têtes de colonnes directement.
On peut le faire sans macro
=INDEX($A$1:$K$1;EQUIV(B$14;DECALER($A$1:$K$1;EQUIV($A15;$A$1:$A$10;0)-1;0);0))Que de solution!!
Merci pour toutes les solutions
effectivement avec la notion de tableau nommé, la programmation est plus simple, en utilisant les entêtes de colonnes au lieu des numéros de colonnes, si on déplace le tableau ou que l'on insère des colonnes dans le tableau, la programmation n'est pas à modifier
exemple :
x=range("tableau1[entêtes de colonne]").cells(numéro de ligne,1)
Bonjour gullaud,
Désolé de répondre si tardivement à ton post, j'avoue ne pas avoir trop compris ta gestion avec les tableau nommé, il te semble donc possible avec cette méthode d'insérer une colonne RH entre chaque colonne entête, si j'ai bien compris le sens de ton message.
Pourrais tu me faire un exemple ( avec éventuellement mon fichier P_VG5.3.xlsm en fin de page 1) que je saisisse mieux ( et que je comprenne surtout ) de quoi il en retourne!
Encore merci pour le temps passé à répondre à mes interrogations que suscitent mon projet,
je te joins 4 fichiers excel pour que tu comprennes mieux la notion de tableau nommé
après examen de ces fichiers, tu pourras mieux me préciser tes questions
cordialement
Merci, je regarde ca pendant le week-end,
je reviens si j'ai des questions,
Bonjour à tous,
edlede, je ne comprends toujours pas à quoi correspondent les colonnes "Rh" 8)
que signifie j+1, j-2 etc.....c'est du chinois tout ça, mets toi à la place des autres
Sur quoi s'appuie t-on pour les compléter ?
Feuille "plan", à quoi correspondent les différents horaires au format texte ?
ton tableau source comporte bien 16 colonnes et non 15 : manque l'en-tête de la colonne 16
En attendant, vois les tableaux restitués en Feuil1 sur la base du 2ème fichier joint
Option Explicit
Sub test()
Dim a, b(), w(), e, i As Long, j As Long, n As Long, myMonth As String
Dim dico1 As Object, dico2 As Object
Set dico1 = CreateObject("Scripting.Dictionary")
dico1.CompareMode = 1
Set dico2 = CreateObject("Scripting.Dictionary")
For Each e In Array("7h30", "8h30", "10h30") 'à adapter
dico1(e) = (dico1.Count + 1) * 2
Next
With Sheets("Plan").Range("a1:p366") 'à adapter
a = .Value
For i = 2 To UBound(a, 1)
If Weekday(a(i, 1)) = 1 Or Weekday(a(i, 1)) = 7 Then
myMonth = Format$(a(i, 1), "mmmm yyyy")
If Not dico2.exists(myMonth) Then
ReDim w(1 To 2)
ReDim b(1 To 11, 1 To (dico1.Count * 2) + 1)
w(1) = 1
b(w(1), 1) = Application.Proper(myMonth)
For j = 2 To UBound(b, 2) Step 2
b(1, j) = dico1.keys()((j / 2) - 1)
b(1, j + 1) = "Rh"
Next
End If
w(1) = w(1) + 1
b(w(1), 1) = a(i, 1)
For j = 6 To UBound(a, 2)
If Not IsEmpty(a(i, j)) Then
'If dico1.exists(a(i, j)) Then
b(w(1), dico1(a(i, j))) = a(1, j)
'End If
End If
Next
w(2) = b
dico2(myMonth) = w
End If
Next
End With
Application.ScreenUpdating = False
'Restitution et mise en forme
With Sheets("Feuil1")
.Cells.Clear
For Each e In dico2.keys
n = n + 1
With .Cells(n, 1)
With .Resize(dico2.Item(e)(1), UBound(dico2.Item(e)(2), 2))
.Value = dico2.Item(e)(2)
.BorderAround Weight:=xlThin
.Borders(xlInsideVertical).Weight = xlThin
With .Rows(1)
.BorderAround Weight:=xlThin
With .Offset(, 1).Resize(, .Columns.Count - 1)
.Interior.ColorIndex = 40
End With
End With
With .Columns(1)
.Columns.ColumnWidth = 30
With .Offset(1).Resize(.Rows.Count - 1)
.Interior.ColorIndex = 19
.NumberFormat = "[$-F800]dddd, mmmm dd, yyyy"
End With
End With
End With
End With
n = n + dico2.Item(e)(1)
Next
With .UsedRange
.Font.Name = "calibri"
.Font.Size = 10
.VerticalAlignment = xlCenter
.HorizontalAlignment = xlCenter
End With
.Activate
End With
Set dico1 = Nothing: Set dico2 = Nothing
Application.ScreenUpdating = True
End Subklin89
bonjour à tous
je pige pas trop pourquoi vouloir du VBA alors qu'il y a ceci un peu plus haut dans ce fil :
Message par Steelson » Mar Mai 30, 2017 12:32 pm
une formule efficace.
Bonjour à tous et merci pour toutes Les réponses,
Je vais essayer de répondre à tous le monde,
Déjà pour Gullaud, j'ai pas fini de regarder les 4 fichier car ce week end j'étais en zone H+ impossible de télécharger le moindre fichier! donc j'ai un peu de retard....
Pour répondre à klin89, ton code correspond bien à ma demande et avec la mise en page plus trop fort ! mais sauf erreur de ma part le tableau ne se complète pas avec les agents correspondants! comme dans le fichier exemple de gmd :"tcd v1b.xlsm" en page 1
Autres petites questions :
Concernant les entêtes
est il possible dans
For Each e In Array("7h30", "8h30", "10h30")de faire référence à une liste par exemple ou que la macro recherche les valeurs déjà saisie? Car le nombre et le nom des d'items variera selon le service
Les j-1 j+2 etc..... correspondent au calcul du jour de récupération par rapport à la date travaillée.
Ex samedi 7/01 -le premier Rh sera à J-1 soit le 06/01
-le second Rh sera à J-2 soit le 05/01
- le troisième Rh sera à J-2 soit le 05/01
Le dimanche 8/01 - Le premier Rh sera à J+2 soit le 10/01
-Le second Rh sera J+2 soit le 10/01
-Le troisième a J+1 soit le 09/01
et jamais de Rh si la date n'est que fériés ( EX si un férié tombe le samedi ou le dimanche le rh est quand même généré")
Et c'est la que j'ai mes trois problèmes
- -----> je ne vérifie pas si la date du Rh calculé est un férié ce qui décale ma date calculé de "-1" pour les samedi et de "+1" pour les dimanches
- ----->Et comment j'arrive à faire le calcule ( via sélection de la bonne colonne Rh ) dans un tableau dont la dimension risque de varié
- ----->je sais plus !!
Effectivement j'ai oublier de mettre un entête dans ma colonne 16 qui correspondais l'agent 11
Et dernière question plus sur la mise en forme est il possible de faire remonter les mois à partir de juillet en ligne 1
2 colonnes après la fin des colonnes de janvier
Pour jmd, La solution de Steelson (vu avec lui en mp) est satisfaisante mais ma feuille d'impression est générer puis supprimer à la fin!
Encore merci à tous pour vos réponses, j'espère que mon complément d'information est à peu pres compréhenssible.
Je reste à votre disposition pour toutes explications complémentaires et mes disponibilités cette semaine seront meilleurs ce qui me permettra de répondre plus rapidement à vos postes
Re edlede,
Dans l'exemple ci dessous, les horaires figurent en colonne 1 d'une feuille nommée "Maliste"
Tu remplaces cette boucle :
For Each e In Array("7h30", "8h30", "9h30", "10h30") 'à adapter
dico1(e) = (dico1.Count + 1) * 2
Nextpar celle-ci :
Dim r As Range
With Sheets("Maliste")
For Each r In .Range("a1", .Range("a" & Rows.Count).End(xlUp))
dico1(r.Value) = (dico1.Count + 1) * 2
Next
End WithLe code pour réajuster l'agencement des différents tableaux
Option Explicit
Sub test()
Dim a, b(), w(), e, i As Long, j As Long, n As Long, t As Long
Dim dico1 As Object, dico2 As Object, myMonth As String
Set dico1 = CreateObject("Scripting.Dictionary")
dico1.CompareMode = 1
Set dico2 = CreateObject("Scripting.Dictionary")
For Each e In Array("7h30", "8h30", "9h30", "10h30") 'à adapter
dico1(e) = (dico1.Count + 1) * 2
Next
With Sheets("Plan").Range("a1:p366") 'à adapter
a = .Value
For i = 2 To UBound(a, 1)
If Weekday(a(i, 1)) = 1 Or Weekday(a(i, 1)) = 7 Then
myMonth = Format$(a(i, 1), "mmmm yyyy")
If Not dico2.exists(myMonth) Then
ReDim w(1 To 2)
ReDim b(1 To 11, 1 To (dico1.Count * 2) + 1)
w(1) = 1
b(w(1), 1) = Application.Proper(myMonth)
For j = 2 To UBound(b, 2) Step 2
b(1, j) = dico1.keys()((j / 2) - 1)
b(1, j + 1) = "Rh"
Next
End If
w(1) = w(1) + 1
b(w(1), 1) = a(i, 1)
For j = 6 To UBound(a, 2)
If Not IsEmpty(a(i, j)) Then
If dico1.exists(a(i, j)) Then
b(w(1), dico1(a(i, j))) = a(1, j)
End If
End If
Next
w(2) = b
dico2(myMonth) = w
End If
Next
End With
Application.ScreenUpdating = False
'Restitution et mise en forme
With Sheets("Feuil1")
.Cells.Clear
For i = 0 To dico2.Count - 1
If i = 0 Then
n = 1: t = 1
Else
If i Mod 3 = 0 Then
n = 1
t = t + UBound(dico2.Items()(i)(2), 2) + 1
End If
End If
With .Cells(n, t)
With .Resize(dico2.Items()(i)(1), UBound(dico2.Items()(i)(2), 2))
.Value = dico2.Items()(i)(2)
.BorderAround Weight:=xlThin
.Borders(xlInsideVertical).Weight = xlThin
.Columns.ColumnWidth = 11
With .Rows(1)
.BorderAround Weight:=xlThin
With .Offset(, 1).Resize(, .Columns.Count - 1)
.Interior.ColorIndex = 40
End With
End With
With .Columns(1)
.Columns.ColumnWidth = 30
With .Offset(1).Resize(.Rows.Count - 1)
.Interior.ColorIndex = 19
.NumberFormat = "[$-F800]dddd, mmmm dd, yyyy"
End With
End With
End With
End With
n = n + dico2.Items()(i)(1) + 1
Next
With .UsedRange
.Font.Name = "calibri"
.Font.Size = 10
.VerticalAlignment = xlCenter
.HorizontalAlignment = xlCenter
End With
.Activate
End With
Set dico1 = Nothing: Set dico2 = Nothing
Application.ScreenUpdating = True
End Subklin89
Bonsoir Klin89,
Ton code répond bien à ma demande, je galères un peu pour l'adapter, surtout l'alimentation des valeurs d'entêtes.
For Each e In Array("7h30", "8h30", "9h30", "10h30") 'à adapter
dico1(e) = (dico1.Count + 1) * 2
NextPar un code du style
tablo = WsPlan.Cells(1).CurrentRegion.SpecialCells(xlCellTypeVisible)
For i = 2 To UBound(tablo, 1)
For j = 2 To UBound(tablo, 2)
If Cells(i, j).Value <> "" Then
dico1(Cells(i, j).Value) = ""
End If
Next j
Next iMais du coup ton code foire sur la mise en forme des tableaux
As tu une autre idée pour "Screener" les valeurs pour la récupération des entêtes. Ainsi quelques soit l'intitulé saisie il sera retranscrit, et qui s'adapte à ton code évidemment
J'avoue êtres un peu perdue dans ton code