Microsoft 365 VBA - Maj Planning (débutant VBA !)

[Galad]

Bonjour,

je me suis proposé d'aider un collègue dans la gestion du planning de ses multiples équipes sur différents sites. j'ai réussi à faire quelque chose qui tient la route sans passer par du VBA mais il s'agit d'une usine à gaz.
Est-il possible en VBA (n'ayant pas les connaissances suffisantes mais je me soigne) d'obtenir le même résultat.
Je m'explique:

Nous avons 4 personnes (identifiés par un numéro - 1111, 2222, 3333 et 4444), 4 sites (SiteA, SiteB, SiteC et SiteD).
Chaque responsable de site envoie en fin de mois (J1, J2, ..., J31) un fichier en précisant la présence, les RTT, Absences ou congés de chaque employé sur son site durant le mois.
Cependant, une même personne peut être présente un même mois sur différents sites ( ex ci dessous). 1111 noté en J1 sur le SiteA n'apparaîtra pas en J2 sur la même ligne mais sera pointé par le Site2 ce jour. De même, 2222 noté en RTT en J2 par le SiteB sera le même jour pointé par le SiteA (en J3 aussi -Congé). D'où des conflits.

Id	J1	J2	J3	…	J31
1111	SiteA
1111		SiteB	SiteB
1111				SiteD	SiteD
2222	SiteB	RTT	Congé	Congé	Congé
2222		SiteA	SiteA
3333	SiteB	SiteB	SiteB	SiteA	SiteA
4444	SiteD		SiteD	SiteD	SiteD

Ce que je voudrais faire en VBA est d'obtenir:
1 seule ligne par personne en faisant en sorte que les cellules renseignées comme Site aient la "préséance" sur toutes les autres (ex: cellules vides ou RTT ou congés ). S'il existe un conflit de plusieurs Sites pour la même personne le même jour, peu importe le choix.
ex final :

Id	J1	J2	J3	…	J31
1111	SiteA	SiteB	SiteB	SiteD	SiteD
2222	SiteB	SiteA	SiteA	Congé	Congé
3333	SiteB	SiteB	SiteB	SiteA	SiteA
4444	SiteD		SiteD	SiteD	SiteD

Bien entendu la quantité de sites ou de personnels peut-être amené à évoluer.

Ne serait-ce que par curiosité intellectuelle possible d'obtenir ce résultat en VBA ?

Merci de vos retours,

Galad

 

[M12]

Bonjour,
Un test avec macro venant de J BOISGONTIER

 

[Galad]

Merci de la réponse rapide et fonctionnelle !

Il ne me reste plus qu'à explorer le code...
EDIT: Cependant: il reste le problème de priorité à donner aux SITES par rapport aux cellules vides, Abs, RTT, CP, FER (fermé/ Férié) etc...
Et ça, je ne sais vraiment pas faire.

Galad

 

[Galad]

Sub RegroupeLigneS()
  ....
      If f1.Cells(ligne, col) <> "" Then f2.Cells(ligT, col) = f1.Cells(ligne, col).Text
    Next col
    If f1.Cells(ligne, ncol) <> "" Then f1.Cells(ligne, ncol).Copy f2.Cells(ligT, ncol)
  Next ligne
End Sub

Si ce n'est en insérant des conditions supplémentaires dans ces lignes mais je n'ai pas encore suffisamment d'aisance pour le faire.
J'essaie de mon côté en tâtonnant.
merci

 

[Deadpool_CC]

bonjour,
lors de la fusion, ajoute juste un test pour voir si ta cellule dans f2 est vide
si pas vide force un texte du genre "Conflit" et regarde déjà si avec des données réelles il y a vraiment des gens qui arrivent à être a 2 endroits en même temps
si Conflit : c'est peut-être aussi une erreur de saisie qui de toute façon doit être corrigée avant ré-intégration.

 

[Galad]

bonjour,
lors de la fusion, ajoute juste un test pour voir si ta cellule dans f2 est vide
si pas vide force un texte du genre "Conflit" et regarde déjà si avec des données réelles il y a vraiment des gens qui arrivent à être a 2 endroit en même temps
si Conflit : c'est peut-être aussi une erreur de saisie qui de toute façon doit être corrigée avant ré-intégration.

merci!
Le problème en fait vient plus du fait que certaines personnes peuvent avoir été taggué par exemple comme en RTT sur un site (Site1) mais envoyé en urgence sur le Site2 et taggué donc comme présent (Site2) le même jour. Selon l'ordre d'arrivée des infos, au final, il peut être donc validé comme en RTT ou comme Site2.
Si il existe un conflit de sites, il m'a été signifié que cela était moins gênant.
Je vais voir pour rajouter un test si f2 est vide ou = CP, RTT, ... mais pour info, mes dernières lignes de codes datent de 1983 sur ZX81 en basic !!! . Donc j'ai un peu de mal à relancer la machine

 

[Deadpool_CC]

j'ai pas chargé le fichier mais un truc du genre devrait fonctionner :

Sub RegroupeLigneS()
  ....
      If f1.Cells(ligne, col) <> "" Then f2.Cells(ligT, col) = f1.Cells(ligne, col).Text
    Next col
    If f1.Cells(ligne, ncol) <> "" Then
        if f2.Cells(ligT, ncol) <> "" Then
            f2.Cells(ligT, ncol) = "OUPPS!"
        else           
            f1.Cells(ligne, ncol).Copy f2.Cells(ligT, ncol)
        end if
    end if
  Next ligne
End Sub

 

[Deadpool_CC]

ou mieux ... concatène les infos

Sub RegroupeLigneS()
  ....
      If f1.Cells(ligne, col) <> "" Then f2.Cells(ligT, col) = f1.Cells(ligne, col).Text
    Next col
    If f1.Cells(ligne, ncol) <> "" Then
        if f2.Cells(ligT, ncol) <> "" Then
            f2.Cells(ligT, ncol) = f2.Cells(ligT, ncol) & " | " & f1.Cells(ligne, ncol)
        else           
            f1.Cells(ligne, ncol).Copy f2.Cells(ligT, ncol)
        end if
    end if
  Next ligne
End Sub

 

[Galad]

Sub RegroupeLigneS()
  ....
  For ligne = 4 To nlig
    crit = f1.Cells(ligne, 1)
    d1(crit) = ""
    ligT = Application.Match(crit, d1.keys, 0)
    For col = 1 To ncol
      If f1.Cells(ligne, col) <> "" And (f2.Cells(ligT, col) = "FER" Or f2.Cells(ligT, col) = "CP" Or f2.Cells(ligT, col) = "RTT") Then f2.Cells(ligT, col) = f1.Cells(ligne, col).Text
    Next col
    If f1.Cells(ligne, ncol) <> "" And (f2.Cells(ligT, col) = "FER" Or f2.Cells(ligT, col) = "CP" Or f2.Cells(ligT, col) = "RTT") Then f1.Cells(ligne, ncol).Copy f2.Cells(ligT, ncol)
  Next ligne
End Sub

Pour l'instant cela marche.
Ce n'est certainement pas propre mais bon !
Je testerai mieux plus tard.

merci