identifier code et dates correspondantes

mix770 · 25 Juillet 2013

Bonjour à vous,

J'adore Excel et mon appétit me conduit encore à faire appel à vous pour avancer

j'ai un tableau de présence remplie par des tiers avec des codes d'absences "cpc / rtt / ...." (janvier dans fichier joint), je souhaiterai que dans l'onglet CMA il sache:
- reconnaitre les codes, ceux ci s’affichant dans la colonne "codes"
- pour la colonne "absence" pas de problème il va chercher l'intitulé en fonction du code
- qu'il affiche dans la colonne "période" la date de début et de fin pour le code.
- pour la colonne nombre pas de problèmes.
cela veut dire qu'il doit créer un ligne pour chaque code inscrit, reconnaitre les dates de début et fin, pour 1 journée date unique et différencier si un rtt à été posé le 10 juillet et un autre le 20 cela fait 2 lignes

j'espère avoir été clair ....
j'ai mis le fichier en PJ

un grand merci à vous tous
bien cordialement

mix770 · 31 Juillet 2013

Re : identifier code et dates correspondantes

je pense peut être avoir trouvé pourquoi ça ne marchait pas dans mon tableau mais dans le modèle que j'ai envoyé..., dans le modèle j'ai mis les mois en janvier, février, etc, alors que dans mon outil final les onglets sont intitulés janv conv, fev conv, etc.. à cause du personnel CDD (EX. JANV CON / JANV CDD).
pas d’inquiétude les CDD ne sont pas à gérer dans ma demande

Dranreb · 31 Juillet 2013

Re : identifier code et dates correspondantes

Dans le modèle initial il n'y avait qu'une feuille source et je considérai que c'était toujours la 1ère feuille du classeur.
Maintenant j'estime qu'il vaut mieux mettre la procédure Collecte (respectez un C majuscule SVP) dans un module ordinaire et lui passer la feuille cible en paramètre :

VB:

Option Explicit

Sub Collecte(ByVal FCbl As Worksheet)
Dim FSrc As Worksheet, Cel As Range, Déb As Date, Te(), Codes(), Périodes(), L As Long, J As Long
On Error Resume Next
Set FSrc = ThisWorkbook.Worksheets(FCbl.[F2].Value)
If Err Then MsgBox "Feuille """ & FCbl.[F2].Value & """ introuvable.", vbCritical, "Collecte": Exit Sub
On Error GoTo 0
Déb = FSrc.[C8].Value - 1
Set Cel = FSrc.[A9:A68].Find(What:=FCbl.[C7].Value, LookIn:=xlValues, LookAt:=xlWhole, _
   SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If Cel Is Nothing Then MsgBox Feuil106.[C7].Value & " inexistant": Exit Sub
Te = Cel.Offset(, 2).Resize(, 32).Value
ReDim Codes(1 To 19, 1 To 1), Périodes(1 To 19, 1 To 2)
L = 0
If Te(1, 1) <> "" Then L = 1: Codes(L, 1) = Te(1, 1): Périodes(1, 1) = Déb + 1
For J = 2 To 32
   If Te(1, J) <> Te(1, J - 1) Then
      If Te(1, J - 1) <> "" Then Périodes(L, 2) = Format(Déb + J - 1, "dd mmm yyyy")
      If Te(1, J) <> "" Then L = L + 1: Codes(L, 1) = Te(1, J): Périodes(L, 1) = Format(Déb + J, "dd mmm yyyy")
      End If
   Next J
FCbl.[A13].Resize(19, 1).Value = Codes
FCbl.[C13].Resize(19, 2).Value = Périodes
End Sub

La feuille source sera celle dont le nom est porté en F2.
Et dans chaque feuille CMA le code sera réduit à :

VB:

Private Sub Worksheet_Activate()
Collecte Me
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$F$2" Or Target.Address = "$C$7" Then Collecte Me
End Sub

mix770 · 2 Août 2013

Re : identifier code et dates correspondantes

bonjour,
oui l'idée est très bonne, je construis mon tableau et vous tiens informé
merci beaucoup
c'est très gentil
bien cordialement

mix770 · 5 Août 2013

Re : identifier code et dates correspondantes

Bonjour,
j'ai suivi vos consignes
- Module créé et Renommé (MCollecte)
- Macro insérée
- 2 feuilles cma créées et macro insérée
cela marche impeccable, pour le mois de janvier, (nom 1-cma1 , nom 2-cma2), mais pour février je n'y arrive pas.
je pensais qu'en renommant une deuxième macro dans le module et dans la feuille cma cela ferai l'affaire, mais je doit zapper un truc. il faudrait qu'il fasse la même chose pour (fevrier, mars, etc) dans chaque feuille CMA.
ci dessous les macro modifiées:

-- MCollecte:
Sub Collecte_2(ByVal FCbl As Worksheet)
Dim FSrc As Worksheet, Cel As Range, Déb As Date, Te(), Codes(), Périodes(), L As Long, J As Long
On Error Resume Next
Set FSrc = ThisWorkbook.Worksheets(FCbl.[F71].Value)
If Err Then MsgBox "Feuille """ & FCbl.[F71].Value & """ introuvable.", vbCritical, "Collecte": Exit Sub
On Error GoTo 0
Déb = FSrc.[C8].Value - 1
Set Cel = FSrc.[A9:A68].Find(What:=FCbl.[C76].Value, LookIn:=xlValues, LookAt:=xlWhole, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If Cel Is Nothing Then MsgBox Feuil106.[C76].Value & " inexistant": Exit Sub
Te = Cel.Offset(, 2).Resize(, 32).Value
ReDim Codes(1 To 19, 1 To 1), Périodes(1 To 19, 1 To 2)
L = 0
If Te(1, 1) <> "" Then L = 1: Codes(L, 1) = Te(1, 1): Périodes(1, 1) = Déb + 1
For J = 2 To 32
If Te(1, J) <> Te(1, J - 1) Then
If Te(1, J - 1) <> "" Then Périodes(L, 2) = Format(Déb + J - 1, "dd mmm yyyy")
If Te(1, J) <> "" Then L = L + 1: Codes(L, 1) = Te(1, J): Périodes(L, 1) = Format(Déb + J, "dd mmm yyyy")
End If
Next J
FCbl.[A13].Resize(19, 1).Value = Codes
FCbl.[C13].Resize(19, 2).Value = Périodes
End Sub

-- feuille CMA 1

Private Sub Worksheet_Change2(ByVal Target As Range)
If Target.Address = "$F$71" Or Target.Address = "$C$76" Then Collecte Me
End Sub

- par ailleurs est il possible dans un code VBA d'ignorer (ne pas afficher) par exemple sur la ligne "nom 1" tout autre code que ceux qui sont dans la liste : $U$2:$V$57 de la feuille cma

merci beaucoup pour le temps que vous prenez pour moi

Dranreb · 5 Août 2013

Re : identifier code et dates correspondantes

Bonjour.
Cette liste est la même pour toutes les feuilles CMA ?
Je viens seulement de découvrir qu'il y a 2 fois la liste dans une CMA.
Ça ne va pas du tout. D'ailleurs je ne comprends même pas pourquoi il y a plusieurs CMA puisque pour obtenir une liste il suffit de changer le mois en F2 qui est un nom de feuille ou la personne en C7. Des listes de validation pourraient faciliter le choix.
En tout cas voici le code qui tient compte de la liste des codes valides :

VB:

Option Explicit

Sub Collecte(ByVal FCbl As Worksheet)
Dim FSrc As Worksheet, Cel As Range, Déb As Date, Te(), Codes(), Périodes(), _
   CodesValides(), DCV As New Dictionary, Valide As Boolean, L As Long, J As Long, Jp As Long
On Error Resume Next
Set FSrc = ThisWorkbook.Worksheets(FCbl.[F2].Value)
If Err Then MsgBox "Feuille """ & FCbl.[F2].Value & """ introuvable.", vbCritical, "Collecte": Exit Sub
On Error GoTo 0
Te = FCbl.Range("U2:U" & FCbl.[U500].End(xlUp).Row).Value
For L = 1 To UBound(Te)
   If Not IsEmpty(Te(L, 1)) Then DCV.Add Te(L, 1), 0
   Next L
Déb = FSrc.[C8].Value - 1
Set Cel = FSrc.[A9:A68].Find(What:=FCbl.[C7].Value, LookIn:=xlValues, LookAt:=xlWhole, _
   SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If Cel Is Nothing Then MsgBox Feuil106.[C7].Value & " inexistant.", vbCritical, "Collecte": Exit Sub
Te = Cel.Offset(, 2).Resize(, 32).Value
ReDim Codes(1 To 19, 1 To 1), Périodes(1 To 19, 1 To 2)
L = 0: J = 1
Do ' Début code
   Valide = DCV.Exists(Te(1, J))
   If Valide Then L = L + 1: Codes(L, 1) = Te(1, J): Périodes(L, 1) = Format(Déb + J, "dd mmm yyyy")
   Do: If J >= 31 Then Exit Do
      J = J + 1: Loop Until Te(1, J) <> Te(1, J - 1)
' Fin code
   If Valide Then Périodes(L, 2) = Format(Déb + J - 1, "dd mmm yyyy")
   Loop Until J >= 31
FCbl.[A13].Resize(19, 1).Value = Codes
FCbl.[C13].Resize(19, 2).Value = Périodes
End Sub

Ajoutez la référence "Microsoft Scripting Runtime" à votre projet VBA.

P.S. À quoi servent les lignes "Remplace" dans les feuilles de mois ? Elles empêchent d'en prendre la colonne A comme liste de validation pour le choix du nom !

mix770 · 5 Août 2013

Re : identifier code et dates correspondantes

pour répondre à votre interrogation, effectivement il y avait 2 listes mais c'est un oubli, en copiant le tableau cela avait copié la liste, d'ailleurs j'ai déplacé la liste dans un onglet "code absences"
pour le CMA nous pourrions travailler en changeant le mois et le nom, mais nous devons garder une trace mois par mois de l'activité de chacun, ce qui oblige à garder le CMA en conséquence.
- Les feuilles remplace permettent de renseigner si la personne est remplacé en cas d'absence prolongée, dans ce cas on renseigne le NB d'heures travaillées
j'ai coché l'option "Microsoft Scripting Runtime" au projet
merci beaucoup

Dranreb · 5 Août 2013

Re : identifier code et dates correspondantes

Oui mais ce n'est pas la peine d'en garder la trace sous les deux formes du moment que la saisie mois par mois est gardée, le CMA l'est aussi puisqu'il peut être reconstitué à tout moment. Il y aurait par contre la possibilité de saisir toujours dans la même feuille du mois en cours et de garder les CMA de chaque mois. Ce serait moins bon. Il serait encore possible de n'avoir qu'une feuille de saisie, une feuille CMA reconstituable et de garder l'historique dans une 3ième feuille. Je joins le classeur dans son état actuel (boiteux)

Dans VBA, menu Outils, Références… Cherchez dans la liste et cochez la dite référence.

Ne vous attendez pas à ce qu'il puisse y avoir plusieurs personnes différentes les unes à la suite des autres dans la feuille CMA, vous n'obtiendrez jamais ça de moi, ce n'est pas négociable. Tout au plus une feuille "impression" temporaire qui les calculeraient pour tous les gens à l'aide de la feuille CMA unique et les y empilerait.

mix770 · 5 Août 2013

Re : identifier code et dates correspondantes

Vous êtes dur en affaire,

en fait ma difficulté est plutôt d'avoir sur la feuille "CMA 1", toujours le même nom mais 1 tableau par mois empilé.
ce que vous m'avez fait est déjà énorme, je vous en suis reconnaissant.
cordialement

Dranreb · 5 Août 2013

Re : identifier code et dates correspondantes

C'est pareil, la feuille CMA c'est une personne pour un mois. Et s'il est nécessaire de constituer un document pour une personne sur tous les mois on le ferait dans une autre feuille, et ce serait juste temporaire.

mix770 · 5 Août 2013

Re : identifier code et dates correspondantes

Oki,
je vous remercie beaucoup et chapeau pour la maitrise, j'adore travailler sur Excel mais je ne suis qu'un petit qui débute
cordialement.

mix770 · 7 Août 2013

Re : identifier code et dates correspondantes

Bonjour Dranreb,
je construit mon outil et je viens de m'apercevoir que la macro ne reconnais que les code lettre, "ex: rtt" en minuscule, il faudrait qu'il puisse ne pas faire de différence entre minuscule et majuscule, sachant que pour les utilisateurs la consigne est d'écrire en majuscule, mais il faut faire avec les étourdis ....
merci à vous

Dranreb · 7 Août 2013

Re : identifier code et dates correspondantes

Bonjour.

Modifiez comme suit la procédure :

VB:

Option Explicit

Sub Collecte(ByVal FCbl As Worksheet)
Dim FSrc As Worksheet, Cel As Range, Déb As Date, Te(), Codes(), Périodes(), DCV As New Dictionary, _
   Valide As Boolean, L As Long, J As Long, Jp As Long, CodCou As String, CodSui As String
On Error Resume Next
Set FSrc = ThisWorkbook.Worksheets(FCbl.[F2].Value)
If Err Then MsgBox "Feuille """ & FCbl.[F2].Value & """ introuvable.", vbCritical, "Collecte": Exit Sub
On Error GoTo 0
Te = FCbl.Range("U2:U" & FCbl.[U500].End(xlUp).Row).Value
For L = 1 To UBound(Te)
   If Not IsEmpty(Te(L, 1)) Then DCV(UCase(Te(L, 1))) = 0
   Next L
Déb = FSrc.[C8].Value - 1
Set Cel = FSrc.[A9:A68].Find(What:=FCbl.[C7].Value, LookIn:=xlValues, LookAt:=xlWhole, _
   SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If Cel Is Nothing Then MsgBox Feuil106.[C7].Value & " inexistant.", vbCritical, "Collecte": Exit Sub
Te = Cel.Offset(, 2).Resize(, 31).Value
ReDim Codes(1 To 19, 1 To 1), Périodes(1 To 19, 1 To 2)
L = 0: J = 1: CodSui = UCase(Te(1, 1))
Do ' Début code
  CodCou = CodSui: Valide = DCV.Exists(CodCou)
   If Valide Then L = L + 1: Codes(L, 1) = CodCou: Périodes(L, 1) = Format(Déb + J, "dd mmm yyyy")
   Do: If J >= 31 Then Exit Do
      J = J + 1: CodSui = UCase(Te(1, J)): Loop Until CodSui <> CodCou
' Fin code
  If Valide Then Périodes(L, 2) = Format(Déb + J - 1, "dd mmm yyyy")
   Loop Until J >= 31
FCbl.[A13].Resize(19, 1).Value = Codes
FCbl.[C13].Resize(19, 2).Value = Périodes
End Sub

mix770 · 8 Août 2013

Re : identifier code et dates correspondantes

Bonjour,

merveilleux, respect ça marche impeccable
je continu d'avancer
un grand merci
bien cordialement

mix770 · 13 Août 2013

Re : identifier code et dates correspondantes

Bonjour Dranred,
j'avance toujours et je vous remercie du coup de main, j'ai enregistré une macro, pour copier / coller le solde de congés sur le masque en fonction du nom de l'agent en C7 du masque, j'ai 30 onglets (nom1,nom2,nom3,etc..) le nom des agents est en "B5"
je ne sais pas comment automatiser la chose, si vous aviez une piste...
ci dessous la macro:

Sub Copie_Solde()
'copie et colle sur masque cma
Sheets("NOM1").Select
Range("C40:N45").Select
Selection.Copy
Sheets("MASQUE CMA").Select
Range("G35").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveWindow.SmallScroll Down:=-6
End Sub

pour effacer c'est ok

merci à vous

Dranreb · 13 Août 2013

Re : identifier code et dates correspondantes

Bonjour.
C'est que je n'ai pas ces 30 feuilles à raison d'une par agent. Était-ce bien nécessaire ? Une liste n'aurait elle pas suffit ?
En tout cas, un peu en aveugle, avec récupération du nom en C7, le code sortit de l'enregistreur pourrait s'optimiser en une seule instruction à la suite dans Collecte:

VB:

FCbl.[G35:R40].Value = ThisWorkbook.Worksheets(FCbl.[C7].Value).[C40:N45].Value

Mais ça fait 2 fois que FCbl.[C7].Value est récupéré dans cette procédure (3 fois si on compte le MsgBox où j'ai d'ailleurs oublié de remplacer Feuil106 par FCbl ce qui est à corriger). Je le récupérerait une seule fois dans une nouvelle variable As String à votre place, que j'utiliserais ensuite pour le Find et pour ça.

identifier code et dates correspondantes

mix770

XLDnaute Impliqué

Pièces jointes

mix770

XLDnaute Impliqué

Dranreb

XLDnaute Barbatruc

Pièces jointes

mix770

XLDnaute Impliqué

mix770

XLDnaute Impliqué

Dranreb

XLDnaute Barbatruc

mix770

XLDnaute Impliqué

Dranreb

XLDnaute Barbatruc

Pièces jointes

mix770

XLDnaute Impliqué

Dranreb

XLDnaute Barbatruc

mix770

XLDnaute Impliqué

mix770

XLDnaute Impliqué

Dranreb

XLDnaute Barbatruc

mix770

XLDnaute Impliqué

mix770

XLDnaute Impliqué

Dranreb

XLDnaute Barbatruc

Discussions similaires