Peupler Calendrier (L = noms, C = Dates) avec data
Bonjour a tous,
j'ai une liste de congés qui se présente ainsi
Noms / date départ / date retour
Noms 1 / date départ 1 / date retour 1
Noms 2 / date départ 2 / date retour 2
et j'aimerais pouvoir créer un calendrier avec en colonnes toutes les dates de l'année
et en lignes une liste prédéfinie de noms.
Le soucis, c'est que j'ai plusieurs dates par noms ET que la liste est assez importante (plusieurs centaines de lignes, et ils demandent un tableau sur 6 mois, soit +180 colonnes)...
J'ai réussi a le faire avec des MATCH et une Array (mais cela était trop exigeant en ressources,
j'essaye donc de le faire en VBA pour optimiser le tout mais en suis incapable.
Le mieux que je puisse faire pour le moment est ceci :
malheureusement, je n'arrive pas a faire correspondre cela a une liste de prenoms et de dates preetablies,
cela me fait simplement "éclater" mes donnees, pas peupler
Voici le code que j'utilise pour le moment :
J;ai beau le triturer dans tous les sens, impossible d'obtenir ce que je desire
Sub Names()
'Application.ScreenUpdating = False
Dim x, YDates, Counted, ColumnCount, j, lColumn
Dim Names(), FoundNames()
YDates = Range("B1").Value
Counted = 0
ColumnCount = 2
ReDim Names(Range("A" & Rows.Count).End(xlUp).Row)
ReDim FoundNames(LBound(Names) To UBound(Names))
lColumn = Cells(1, Cells(1, Columns.Count).End(xlToLeft).Column).Column
For Each c In Range(Range("A2"), Range("A" & Rows.Count).End(xlUp))
If YDates <> Range("B" & c.Row).Value Then
For i = LBound(Names) To UBound(Names)
If Names(i) <> "" Then
j = j + 1
FoundNames(j - 1) = Names(i)
End If
Next i
ReDim Preserve FoundNames(LBound(Names) To j)
Cells(1, lColumn + ColumnCount).Value = YDates
For i = LBound(FoundNames) To UBound(FoundNames)
Cells(i + 2, lColumn + ColumnCount).Value = FoundNames(i)
Next
ColumnCount = ColumnCount + 1
YDates = Range("B" & c.Row).Value
Counted = 0
ReDim Names(Range("A" & Rows.Count).End(xlUp).Row)
ReDim FoundNames(LBound(Names) To UBound(Names))
End If
If InStr(Join(Names, ","), c.Value) < 1 Then
Names(Counted) = c.Value
Counted = Counted + 1
End If
Next c
j = 0
For i = LBound(Names) To UBound(Names)
If Names(i) <> "" Then
j = j + 1
FoundNames(j - 1) = Names(i)
End If
Next i
ReDim Preserve FoundNames(LBound(Names) To j - 1)
Cells(1, lColumn + ColumnCount).Value = YDates
For i = LBound(FoundNames) To UBound(FoundNames)
Cells(i + 2, lColumn + ColumnCount).Value = FoundNames(i)
Next
'Application.ScreenUpdating = True
End Sub
et un fichier reprenant mon résultat actuel ainsi ce que j'aimerais obtenir
Pourriez-vous m'aider s'il vous plait?
Je vous remercie infiniement!
Picsou
Bonjour,
Ton pseudo te va comme un gant : T'es aussi radin en détails !
Ton fichier que t'aimerai obtenir ne montre pas grand chose et cette liste de John est un peu incompréhensible.
Donc si j'ai compris de travers ce sera de ta faute... Et non pas parce que mon pseudo me va comme un gant !
A+
Bonjour Galopin,
je présente si mon post manquait de précisions, tu n'as pas compris de travers, mais ce n'est pas exactement ce que je désirais, donc mea maxima culpa....
En gros, j'ai une liste prédéfinie de noms en lignes au tableau,
le but c'est aussi d'obtenir une correspondance avec ces lignes, car le tableau est fixe.
De plus, le meme prenom peut revenir plusieurs fois dans les données.
Apres, je désire aussi rajouter les return dates, mais bon, je ne le précisais pas parce que j'estime que je dois aussi faire un effort de mon coté
Merci beaucoup Galopin
Bonjour Picsou, bonjour galopin01
Je suis peut-être loin du compte, mais je pense qu'il s'agit de faire un tableau de congés.
Une proposition uniquement en mises en formes conditionnelles.
La première date de la périoide est à mettre en Report!$B$3, tout suivra.
Cordialement
Bonjour,
Tu me dis si la réponse de Efgé te convient : Dans ce cas pas la peine que je me fatigue
A+
Ca fonctionne parfaitement avec les mises en forme conditionnelles,
merci infiniement pour votre aide!