XL 2016 Macro: Eviter les conflits ente les noms et les dates

[karakoman1]

Bonjour le forum,
J'aimerais si c'est possible, pouvoir importer dans un tableau comportant des dates, des noms de personnes provenant d'une liste, tout en évitant de mettre ces personnes les jours ou ils sont indisponibles.
Un exemple concret vaut mieux que mes explications. (Voir fichier)
Voici la macro dans laquelle il faudrait pouvoir l'intégrer.

Sub Test_V2()
'Variables
Dim t As Variant, i&, lgDeb&, nCopy&, item$
'valeurs dans l'array
Application.ScreenUpdating = False

                  'Copier coller la liste des joueurs et le nombre de fois sur la feuille 4

    Sheets("Tableau").Range("N3:N12").Copy Destination:=Sheets("Feuil2").Range("A1")
Sheets("Tableau").Range("L3:L12").Copy Destination:=Sheets("Feuil2").Range("B1")
Sheets("Feuil2").Select



                ' Faire 4 colonnes de 30 noms sur la feuil2

t = Range("a1").CurrentRegion
lgDeb = 1 'début ligne
'boucle
For i = 1 To UBound(t, 1)
     item = t(i, 2): nCopy = t(i, 1) - 1
     If nCopy > -1 Then
     Range("d" & lgDeb & ":d" & (lgDeb + nCopy)).Value = item 'recopie en colonne d
     lgDeb = lgDeb + nCopy + 1 'incrément
     Range("D1").Select
    Range(Selection, Selection.End(xlDown)).Select
     End If
Next



Dim TSrc(), RngCbl As Range, TCbl(), LSrc As Long, CSrc As Long, LCbl As Long, CCbl As Long
TSrc = Selection.Value
On Error Resume Next
Set RngCbl = Range("f1:i30")
If Err Then Exit Sub
On Error GoTo 0
ReDim TCbl(1 To RngCbl.Rows.Count, 1 To RngCbl.Columns.Count)
CCbl = 1
For CSrc = 1 To UBound(TSrc, 2)
    For LSrc = 1 To UBound(TSrc, 1): LCbl = LCbl + 1
       If LCbl > UBound(TCbl, 1) Then
          LCbl = 1: CCbl = CCbl + 1: If CCbl > UBound(TCbl, 2) Then Exit For
          End If
       TCbl(LCbl, CCbl) = TSrc(LSrc, CSrc): Next LSrc, CSrc
RngCbl.Value = TCbl
                'Importer les 4 plages de 30 noms dans le tableau
Range("F1").Select
Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("Tableau").Select
    Range("c3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Feuil2").Select
    Range("G1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Tableau").Select
    Range("e3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Feuil2").Select
    Range("H1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Tableau").Select
    Range("g3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Feuil2").Select
    Range("I1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Tableau").Select
    Range("i3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
     Sheets("Feuil2").Select
        Cells.Select
    Selection.ClearContents
    Range("A1").Select
    Sheets("Tableau").Select
    Range("B2").Select

   'Appel des macros "mixer_joueur" et les executer 5 fois chacune
    For i = 1 To 5
Application.Run "Module1.Mixer_joueur_1"
Application.Run "Module1.Mixer_joueur_2"
Application.Run "Module1.Mixer_joueur_3"
Application.Run "Module1.Mixer_joueur_4"
Next

  Application.ScreenUpdating = True
End Sub

Merci d'avance à qui pourra m'aider

 

[mapomme]

Bonjour karakoman1,

Quelques formules suffisent à faire le travail...

 

[karakoman1]

Bonjour mapomme,
Je te remercie de ton aide, mais le but de ma demande est de mettre les 30 noms de chaque plage dans chaque leur colonne.
Ta formule laisse les trous mais ne remplace pas les noms manquants par un autre de la même plage pour au total avoir bel et bien mes 30 noms prévus de la plage de départ.
De plus, j'ai déjà pas mal de macros dans ce fichier dont une qui importe bien les données dans le tableau, mais qui ne vérifie pas que la personnes soit disponible ou pas.
D'où ma question!!
L'idée aurait pu être interessante.
Merci pour ta disponibilité
Bonne journée

 

[mapomme]

Re,

a formule laisse les trous mais ne remplace pas les noms manquants par un autre de la même plage pour au total avoir bel et bien mes 30 noms prévus de la plage de départ.

Je ne comprends pas tout. On prend la première colonne. Dans le tableau de la feuille Feuil2 se trouvent deux prénoms Bruno et Raymond. Supposons que les deux soient absents le 20/09/2017, que met on dans la cellule C3 sur le feuille Tableau ?

 

[karakoman1]

Re,
mapomme,
Pour répondre à ta question, il est vrai que dans le cas de la première colonne, si aucune des deux personnes n'est disponibles , il y aura un problème.
Mais si je devais avoir ce problème la, je peux modifier une option au départ qui me fournira 4 nouvelles colonnes avec d'autres noms dans la Feuil2.

 

[Staple1600]

Bonjour le fil, le forum

Bonjour mapomme

Re,
Je ne comprends pas tout.

Rassures-toi, moi non plus à l'époque du premier fil , je ne comprenais pas.
Sauf qu'il s'agit d'un tournoi de tennis.

 

[karakoman1]

Bonjour Staple1600,

C'est vrai que depuis le début, mon fichier a bien avancé. Un peu beaucoup grâce à toi!!!

Par contre, tu es resté bloqué au "tournoi de tennis", mais comme je te l'ai déjà dis plusieurs fois, ce n'est pas un tournoi de tennis, mais plutôt un tableau de rencontres amicales entre amis qu'on organise pendant la saison hivernale.
La location d'un terrain pour une saison hivernale commence le 20/09/17 jusqu'au 11/04/18 (soit 30 semaines à raison d'une heure par semaine, ici le mercredi).
Chaque joueur donne le nombre de fois qu'il à envie de jouer et ses indisponibilités.

Il y à 30 dates et 4 places par dates (puisqu'on joue en double) Soit 120 places au total.
Moins les dates ou le club organise ses "tournois"
Et la, je pense avoir tout expliqué... Tu ne penses pas? Si pas demande et je me ferais fort de détailler plus.

Pour que tu vois que tu ne fais pas tout ça pour rien, je te joint mon fichier PRESQUE fini.

La structure de la feuille tableau n'est pas la même que sur la dernière demande que j'ai faite pour les conflits Noms/Dates, mais si je trouve la solution pour éviter ces conflits, je l'adapterais.
Pour l'instant je fonctionne avec des colonnes cachées au niveau de la plage des indisponibilités pour la mise en forme conditionnelle si il y en a une.

Merci encore pour toute ton aide apportée à sa réalisation

 

[Staple1600]

Re

@karakoman1
Merci pour ces précisions mais mon précédent message s'adressait à mapomme.
J'aurais du préciser qu'il s'agissait d'une sorte de private joke entre lui et moi.

 

[mapomme]

Re karakoman1 , bonjour à Staple1600 ,

Un essai en VBA pour compléter les cellules à conflit. Attention ! Deux tirage successifs pourront donner des résultats différents pour ces cellules (voir la quatrième colonne)

 

[karakoman1]

Re,
Merci pour ton aide.
Ca à l'air de très bien fonctionner sur le fichier joint, mais quand je le met dans le mien, j'ai une erreur

Aurais-tu une idée du pourquoi ?
Je l'ai mise dans la même feuille que dans le fichier exemple, et j'appelle la macro via la ligne de commande:
Application.Run "Feuil4.RemplirTableau"

Je te met le code au complet pour que tu puisse voir l'ensemble

Sub Test_V2()
''''''''''''''''''''''''''''''''''''''''''''''''''''
     'Copier coller la liste des joueurs et le nombre de fois sur la feuille 4
    Sheets("Tableau").Range("N3:N12").Copy Destination:=Sheets("Feuil2").Range("A1")
    Sheets("Tableau").Range("L3:L12").Copy Destination:=Sheets("Feuil2").Range("B1")
    Sheets("Feuil2").Select
'''''''''''''''''''''''''''''''''''''''''''''''''''
    ' On fait 1 colonnes avec les noms et les copie autant de fois que demandé sur la feuil2 ( Staple1600)

'Variables T
Dim T As Variant, i&, lgDeb&, nCopy&, item$
'valeurs dans l'array
Application.ScreenUpdating = False
 
T = Range("a1").CurrentRegion
lgDeb = 1 'début ligne
'boucle
For i = 1 To UBound(T, 1)
     item = T(i, 2): nCopy = T(i, 1) - 1
     If nCopy > -1 Then
     Range("d" & lgDeb & ":d" & (lgDeb + nCopy)).Value = item 'recopie en colonne d
     lgDeb = lgDeb + nCopy + 1 'incrément
     Range("D1").Select
    Range(Selection, Selection.End(xlDown)).Select
     End If
Next
''''''''''''''''''''''''''''''''''''''''''''''''''''''
  '''' Repartition des données en 4 colonnes de 30 noms  ( Dranreb )''''
'Le principe d'utilisation de ma macro:
'1) — vous sélectionnez la plage source (elle peut ou non comporter déjà plusieurs colonnes)
'2) — vous exécutez la macro
'3) — vous sélectionnez la plage destinatrice (InputBox), Entrée.
'S 'il vous faut autre chose, débrouillez vous pour initialiser autrement la variable RngCbl, pareil pour une nouvelle RngSrc, que vous utiliserez dans la macro au lieu de Selection.
'Lecture et remplissage: de gauche à droite, puis, arrivé à la dernière colonne, de haut en bas.

'Variables
Dim TSrc(), RngCbl As Range, TCbl(), LSrc As Long, CSrc As Long, LCbl As Long, CCbl As Long
TSrc = Selection.Value
On Error Resume Next
Set RngCbl = Range("f1:i30")
If Err Then Exit Sub
On Error GoTo 0
ReDim TCbl(1 To RngCbl.Rows.Count, 1 To RngCbl.Columns.Count)
CCbl = 1
For CSrc = 1 To UBound(TSrc, 2)
    For LSrc = 1 To UBound(TSrc, 1): LCbl = LCbl + 1
       If LCbl > UBound(TCbl, 1) Then
          LCbl = 1: CCbl = CCbl + 1: If CCbl > UBound(TCbl, 2) Then Exit For
          End If
       TCbl(LCbl, CCbl) = TSrc(LSrc, CSrc): Next LSrc, CSrc
RngCbl.Value = TCbl
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Importer les 4 plages de 30 noms dans le tableau
'Worksheets("Feuil2").Range("F1:F30").Copy
'Worksheets("Tableau").Range("C3").PasteSpecial Paste:=xlValues
   'Worksheets("Feuil2").Range("G1:G30").Copy
   'Worksheets("Tableau").Range("E3").PasteSpecial Paste:=xlValues
      'Worksheets("Feuil2").Range("H1:H30").Copy
      'Worksheets("Tableau").Range("G3").PasteSpecial Paste:=xlValues
        'Worksheets("Feuil2").Range("I1:I30").Copy
        'Worksheets("Tableau").Range("I3").PasteSpecial Paste:=xlValues

Application.Run "Feuil4.RemplirTableau"


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Effacer le contenu de la feuil2 et revenir sur la feuille "Tableau"
Sheets("Feuil2").Range("A1:I200").ClearContents
Sheets("Tableau").Select
Range("B2").Select
   
''''''''''''Appel des macros "mixer_joueur" et les executer 5 fois chacune ( Staple1600 )
    'For i = 1 To 5
'Application.Run "Module1.Mixer_joueur_1"
'Application.Run "Module1.Mixer_joueur_2"
'Application.Run "Module1.Mixer_joueur_3"
' Application.Run "Module1.Mixer_joueur_4"
'Next
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  Application.ScreenUpdating = True
  Range("B2").Select
End Sub

Merci encore pour ton aide

 

[mapomme]

Re,

Ca à l'air de très bien fonctionner sur le fichier joint, mais quand je le met dans le mien, j'ai une erreur


Aurais-tu une idée du pourquoi ?
Je l'ai mise dans la même feuille que dans le fichier exemple, et j'appelle la macro via la ligne de commande:

J'utilise des objets de type Dictionary qui est défini dans une bibliothèque de Microsoft. Dans ton environnement, cette bibliothèque n'est pas référencée. Je te propose une autre version du code qui va automatiquement référencer cette bibliothèque (Microsoft.Scripting.Runtime).

 

[karakoman1]

Re,
Avec celui-ci, ca fonctionne, mais je constate que ca change le nombre de fois que chaque personne était prévue dans le tableau initial. Il n'y a pas moyen de respecter ce nombre défini?
Dans l'immédiat, je vais devoir laisser mon PC de coté, nous avons une petite sortie ce soir.
Je le testerais plus en détail dès que possible.
Je te remercie pour le temps passé sur mon projet.
Bonne soirée

 

[mapomme]

Re,

mais je constate que ca change le nombre de fois que chaque personne était prévue dans le tableau initial. Il n'y a pas moyen de respecter ce nombre défini?

Là, j'ai un peu de mal à comprendre. Si la personne est absente à la date où on l'avait prévue (tableau de la feuille Feuil2), il faut bien la remplacer par une autre personne, non ? Donc la répartition est modifiée.

 

[karakoman1]

Re,
Petite explication:
Sur la feuil2 les 4 listes de personnes qui sont la ne sont pas déjà prévues pour une date définie, elles le seront une fois misent dans le tableau. Les 4 listes de la feuil2 sont faites via une macro qui:
1 - dans un premier temps, mets dans une même colonne les noms des différents joueurs autant de fois qu'ils l'ont demandé pour un total de 120 lignes ( nombre de places disponibles dans le tableau)
2- cette même macro scinde cette colonne en 4 listes de 30 noms. Les fameuse 4 listes!!
L'idéal serait de mélanger les noms de chaque listes avant le de les recopier dans le tableau pour ne pas qu'un joueur joue tout ces matchs soit en début de saison ou en fin de saison et reste de longues semaines sans jouer.
C'est une fois les noms recopiés dans le tableau et seulement la,que les dates sont attribuées à chaque joueur.
J'espère avoir pu te renseigner suffisamment pour pouvoir comprendre le fonctionnement de mon fichier.
Bonne soirée

 

[mapomme]

Bonjour karakoman1

Avec les dernières explication, une version v3.

• le bouton Hop! remplit le tableau de la feuille "Tableau" à partir du tableau de la feuille "Feuil2"
• le bouton Figer le résultat copie le tableau de la feuille "Tableau" sur la feuille "Rencontres 2017-18" (pour éviter de modifier le tableau de la feuille "Tableau"par un clique malencontreux sur le bouton Hop!)
• Pour permettre de figer à nouveau le tableau, il faut effacer à la main les données des cellules B3:C32; E3:E32; G3:G32; I3:I32 du tableau de la feuille "Rencontres 2017-18"
• Une fois un calendrier figé, il faut travailler sur la feuille "Rencontres 2017-18"

Je n'ai fait que peu d'essais. A toi de voir si c'est OK ou non.