Insérer des noms en fonction d'une date

Callypse

XLDnaute Nouveau
Bonjour,
je sollicite votre aide car après y avoir passé des heures, mes compétences ont atteint leurs limites...
J'ai réalisé un classeur dans le cadre de mon boulot aux RH.
Il comprend plusieurs feuilles qui me permettent d'avoir tous les outils qui me sont nécessaires sous la main.
Le but étant de réaliser une feuille de garde journalière incrémentant toutes les compétences du personnel.
Il y a dans ce classeur, une feuille "SPV" qui regroupe les gardes des pompiers volontaires et une feuille "SPP" qui regroupe les gardes des pompiers professionnels.
Ce que je voudrais, c'est pouvoir afficher dans ma "feuille de garde", les noms des personnels de garde en fonction de la date. (ex : si je tape 01/10/2015 dans ma "feuille de garde", je voudrais qu'apparaisse automatiquement dans les colonnes "SPP en G", "SPP en J"...le nom du personnel qui travail, ce qui m'éviterait de passer des heures à feuilleter les tableaux "SPP" et "SPV"à la recherche des informations...)
En espérant vous lire bientôt...

Le classeur en question : Document Cjoint
 

PMO2

XLDnaute Accro
Re : Insérer des noms en fonction d'une date

Bonjour,

Sur une copie de votre classeur, copiez le code suivant dans la fenêtre de code de la feuille "Feuille de garde"
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$A$3" Then Call GetNomPersonnel
End Sub

Private Sub GetNomPersonnel()
Dim S As Worksheet
Dim R As Range
Dim rG As Range
Dim rJ As Range
Dim DateCible As Date
Dim var
Dim i&
Dim j&
Dim A$
'---
If Not IsDate(Range("a3")) Then Exit Sub
DateCible = CDate(Range("a3"))

'### SPP ###
Range("I6:I17,I19:I24").ClearContents
Set rG = Range("I6")
Set rJ = Range("I19")
'---
Set S = Sheets("SPP")
Set R = S.[a1].CurrentRegion
var = R
'---
For i& = 1 To UBound(var, 1)
  If IsDate(var(i&, 5)) Then
    If DateCible = CDate(var(i&, 5)) Then
      For j& = 11 To UBound(var, 2)
        '--- G ---
        If var(i&, j&) = "G" Then
          A$ = var(3, j&)
          A$ = Replace(A$, Chr(10), Space(1))
          rG = A$
          Set rG = rG.Offset(1, 0)
        End If
        '--- J ---
        If var(i&, j&) = "J" Then
          A$ = var(3, j&)
          A$ = Replace(A$, Chr(10), Space(1))
          rJ = A$
          Set rJ = rJ.Offset(1, 0)
        End If
      Next j&
    End If
  End If
Next i&

'### SPV ###
Range("K6:K12,K14:K20").ClearContents
Set rG = Range("K6")
Set rJ = Range("K14")
'---
Set S = Sheets("SPV")
Set R = S.UsedRange
var = R
'---
For i& = 1 To UBound(var, 1)
  If IsDate(var(i&, 2)) Then
    If DateCible = CDate(var(i&, 2)) Then
      For j& = 14 To UBound(var, 2)
        '--- G ---
        If var(i&, j&) = "G" Then
          A$ = var(3, j&) & Space(1) & var(4, j&)
          A$ = Replace(A$, Chr(10), Space(1))
          rG = A$
          Set rG = rG.Offset(1, 0)
        End If
        '--- J ---
        If var(i&, j&) = "J" Then
          A$ = var(3, j&)
          A$ = Replace(A$, Chr(10), Space(1))
          rJ = A$
          Set rJ = rJ.Offset(1, 0)
        End If
      Next j&
    End If
  End If
Next i&
End Sub

A chaque changement en A3, les noms de personnel devraient apparaître (si c'est bien une date qui a été entrée).
 

Callypse

XLDnaute Nouveau
Re : Insérer des noms en fonction d'une date

Bonjour,
tout d'habord, merci et bravo, cela fonctionne pour les personnel spp en G, J et le personnel SPV en G. Par contre si je mets un personnel de la feuille "SPP" en N, il n'apparait pas dans la colonne SPP en N de la "Feuille de garde". Est il possible de le rajouter ?
Egalement, dans la feuille SPV, on a JS et JW qui n'ont qu'un but statistique afin de savoir en fin d'année qui prend le plus de Journée Semaine et de Journée Week-end. Pour ma feuille de garde, je les considère les deux comme des J, je ne tiens pas compte du S ou du W. Serait il possible de les faire également apparaitre ? Les JS et JW apparaitraient dans la colonne SPV en J, et les N dans la colonne SPV en N de la "feuille de garde".
Merci encore pour le travail déja réalisé !!!
Dans l'attente de vous lire.
Cordialement
 

PMO2

XLDnaute Accro
Re : Insérer des noms en fonction d'une date

Bonjour,

OK.
Essayez ce nouveau code qui, si je ne suis pas empêtré, devrait le faire.
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$A$3" Then Call GetNomPersonnel
End Sub

Private Sub GetNomPersonnel()
Dim S As Worksheet
Dim R As Range
Dim rG As Range
Dim rJ As Range
Dim rN As Range
Dim DateCible As Date
Dim var
Dim i&
Dim j&
Dim A$
'---
If Not IsDate(Range("a3")) Then Exit Sub
DateCible = CDate(Range("a3"))

'### SPP ###
Range("I6:I17,I19:I24,I26:I28").ClearContents
Set rG = Range("I6")
Set rJ = Range("I19")
Set rN = Range("I26")
'---
Set S = Sheets("SPP")
Set R = S.[a1].CurrentRegion
var = R
'---
For i& = 1 To UBound(var, 1)
  If IsDate(var(i&, 5)) Then
    If DateCible = CDate(var(i&, 5)) Then
      For j& = 11 To UBound(var, 2)
        '--- G ---
        If var(i&, j&) = "G" Then
          A$ = var(3, j&)
          A$ = Replace(A$, Chr(10), Space(1))
          rG = A$
          Set rG = rG.Offset(1, 0)
        End If
        '--- J ---
        If var(i&, j&) = "J" Then
          A$ = var(3, j&)
          A$ = Replace(A$, Chr(10), Space(1))
          rJ = A$
          Set rJ = rJ.Offset(1, 0)
        End If
        '--- N ---
        If var(i&, j&) = "N" Then
          A$ = var(3, j&)
          A$ = Replace(A$, Chr(10), Space(1))
          rN = A$
          Set rN = rJ.Offset(1, 0)
        End If
      Next j&
    End If
  End If
Next i&

'### SPV ###
Range("K6:K12,K14:K20,K22:K28").ClearContents
Set rG = Range("K6")
Set rJ = Range("K14")
Set rN = Range("K22")
'---
Set S = Sheets("SPV")
Set R = S.UsedRange
var = R
'---
For i& = 1 To UBound(var, 1)
  If IsDate(var(i&, 2)) Then
    If DateCible = CDate(var(i&, 2)) Then
      For j& = 14 To UBound(var, 2)
        '--- G ---
        If var(i&, j&) = "G" Then
          A$ = var(3, j&) & Space(1) & var(4, j&)
          A$ = Replace(A$, Chr(10), Space(1))
          rG = A$
          Set rG = rG.Offset(1, 0)
        End If
        '--- J (JS ou JW)---
        If var(i&, j&) = "JS" Or var(i&, j&) = "JW" Then
          A$ = var(3, j&) & Space(1) & var(4, j&)
          A$ = Replace(A$, Chr(10), Space(1))
          rJ = A$
          Set rJ = rJ.Offset(1, 0)
        End If
        '--- N ---
        If var(i&, j&) = "N" Then
          A$ = var(3, j&) & Space(1) & var(4, j&)
          A$ = Replace(A$, Chr(10), Space(1))
          rN = A$
          Set rN = rN.Offset(1, 0)
        End If
      Next j&
    End If
  End If
Next i&
End Sub
 

Statistiques des forums

Discussions
311 730
Messages
2 081 981
Membres
101 855
dernier inscrit
alexis345