planning des taches, utilisation de matrices?

[TJ]

Bonjour,
J'essaie de peaufiner un planning sous excel pour un club de basket...
Voici le pb. sur lequel je bute pour le moment.

J'ai une table des matchs avec des infos telles que:
Date, Heure, Lieu (Exterieur/Domicile), Arbitre1, Arbitre2, Resp_Salle, Resp_Table_de_Marque, Resp_Chronometrage.
Les champs Arbitre1, Arbitre2, Resp_Salle, Resp_Table_de_Marque, Resp_Chronometrage sont remplis pour les matchs a domicile avec le nom des membres du club assignes pour le match (liste de membres pour la validation).

Je cherche a creer une table pour chaque membre assigné à au-moins une tâche lui indiquant pour chaque match concerne (date, heure) les tâches sous sa responsabilite. Ceci devant se faire de maniere dynamique en fonction des modifs de la table des matchs.

Exemple:
Nom Durant Marie
Date,Horaire,Equipe, Arbitre,Salle,Marque,Chrono
6.12.03,14H00,Poussines , X, X
15H30,Benjamins , , X
19.12.03,17H00,Minimes X , ,

Nom Muller Jean
Date,Horaire,Equipe, Arbitre,Salle,Marque,Chrono
6.12.03,14H00,Poussines X , ,
19.12.03,17H00,Minimes , X , X etc...

Comment faire? Quelle est la solution la plus simple,efficace,...?

Merci pour votre aide.
Salutations sportives.
Thierry

 

[Zon]

Salut,

Peut en macro évènementielle, mais dans le cas présent un fichier exemple serait le bienvenue...


A+++

 

[TJ]

Bonjour,

voici l'exemple dans l'etat d'avancement actuel.
La feuille Service presente une maquette des donnees taches a laquelle je souhaite aboutir.

Merci.
A+ Thierry

 

[Zon]

Salut,

Tiens voici une version à tester dans le fichier joint, ne touches pas la feuille services pour le moment: la mise en forme est à revoir certainement comme c'est pas mon truc; Testes tous les cas de figures en vérifiant bien que cela te donne le résultat attendu.

Il me semble que faire de qqch de dynamique à la saisie risque d'être fastidieux et pas trés rapide entre chaque saisie, donc j'ai mis un bouton sur la feuille services qui te lance la macro.

Pour que le fichier passe sur le forum j'ai supprimé la feuille Planning.

A+++

 

[TJ]

Salut,

j'ai teste, ca marche super.
Dans la fonction princ, j'ai rajoute la gestion des sauts de page.

Il y a juste un petit hic dans le cas ou plusieurs tâches sont assignées à la même personne pour le même match.

Il faudrait:
1: que je trie les résultats par horaire (date+heure)
2: que je n'imprime qu'une ligne avec plusieurs X dans les cas ou la date et l'heure restent constants

Faut-il les integrer dans la fonction recherche ou dans la procédure Princ?

Merci beaucoup,
A+ Thierry

Adjoint Princ apres modifs:
Sub Princ()
Dim T, T1, I As Long, Ligne As Long, J As Long
T1 = Range(PlageDef).Value
Worksheets(NomF1).Range("B4:J65536").ClearContents
Worksheets(NomF1).Rows.PageBreak = xlNone
For I = LBound(T1) To UBound(T1)
If Len(T1(I, 1)) > 0 Then
T = Recherche(Worksheets(NomF2).Range(Plage), T1(I, 1))
If IsArray(T) Then
With Worksheets(NomF1)
Ligne = .[D65536].End(xlUp).Row + 1
.Range("B" & Ligne) = Left(T1(I, 1), InStr(T1(I, 1), " ") - 1)
.Range("C" & Ligne) = Right(T1(I, 1), Len(T1(I, 1)) - InStr(T1(I, 1), " "))
.Range("D" & Ligne, "G" & Ligne + UBound(T, 2)) = Application.Transpose(T)
.Range("G" & Ligne & ":G65536").ClearContents
For J = LBound(T, 2) To UBound(T, 2)
Select Case T(3, J)
Case ColArb1, ColArb2: .Range("G" & Ligne) = "X"
Case ColChrono: .Range("H" & Ligne) = "X"
Case ColMarq: .Range("I" & Ligne) = "X"
Case ColSalle, ColBuv: .Range("J" & Ligne) = "X"
End Select
Ligne = Ligne + 1
Next J
End With
Worksheets(NomF1).Rows(Ligne - 1).PageBreak = xlPageBreakManual
End If
Worksheets(NomF1).PageSetup.PrintArea = "A1:J" & Ligne - 2 & ""
End If
Next I
End Sub

 

[Zon]

Salut,

En effet j'avais pas remarqué cette éventualité, regardes dans le fichier joint, j'ai effectivement rajouter une boucle dans la fonction Recherche. Enfin j'ai rajouté une procédure pour le tri par date horaire et par nom.


A+++

Bonne année.

 

[TJ]

Salut,

Merci mille fois, j'ai pu arriver a mes fins.
Ci-dessous la dernière version du code.
J'ai utilisé une fonction de tri par bulles et fais quelques modifs sur les fonction princ et recherche pour faire tourner la macro sans faille.
J'ai aussi rajouté une colonne avant D en recopiant la date pour afficher le jour.
Tout cela m'a permis de bien comprendre la macro que tu avais envoyée.
La base de tout.

Vraiment génial...

A+++

Bonne année.

'**************************************
Option Explicit

Const Plage As String = "O2:T65536"
Const NomF1 As String = "Service"
Const NomF2 As String = "matchs"
Const PlageDef As String = "NomPrénom"
Const PlageNom As String = "Nom"
Const PlagePrénom As String = "Prénom"
'feuille matchs
Const ColDate As Byte = 1
Const ColHor As Byte = 3
Const ColDom As Byte = 8
Const ColArb1 As Byte = 15
Const ColArb2 As Byte = 16
Const ColChrono As Byte = 17
Const ColMarq As Byte = 18
Const ColSalle As Byte = 19
Const ColBuv As Byte = 20
Const ColCat As Byte = 22
'**************************************
Sub Princ()
Dim T, T1, TN, TP, i As Long, Ligne As Long, j, k As Long
T1 = Range(PlageDef).Value
TN = Range(PlageNom).Value
TP = Range(PlagePrénom).Value
Worksheets(NomF1).Range("B4:K65536").ClearContents
Worksheets(NomF1).Rows.PageBreak = xlNone
For i = LBound(T1) To UBound(T1)
If Len(T1(i, 1)) > 0 Then
T = Recherche(Worksheets(NomF2).Range(Plage), T1(i, 1))
If IsArray(T) Then
With Worksheets(NomF1)
Ligne = .[D65536].End(xlUp).Row + 1
.Range("B" & Ligne) = TN(i, 1)
.Range("C" & Ligne) = TP(i, 1)
For j = LBound(T, 2) To UBound(T, 2)
If j > 0 And j < UBound(T, 2) Then
If (T(0, j) = T(0, j - 1) And T(1, j) = T(1, j - 1)) Then
Ligne = Ligne - 1
End If
End If
.Range("D" & Ligne) = T(0, j)
.Range("E" & Ligne) = T(0, j)
.Range("F" & Ligne) = T(1, j)
.Range("G" & Ligne) = T(2, j)
Select Case T(3, j)
Case ColArb1, ColArb2: .Range("H" & Ligne) = "X"
Case ColChrono: .Range("I" & Ligne) = "X"
Case ColMarq: .Range("J" & Ligne) = "X"
Case ColSalle, ColBuv: .Range("K" & Ligne) = "X"
End Select
Ligne = Ligne + 1
Next j
End With
Worksheets(NomF1).Rows(Ligne - 1).PageBreak = xlPageBreakManual
End If
Worksheets(NomF1).PageSetup.PrintArea = "A1:K" & Ligne - 2 & ""
End If
Next i
End Sub
'**************************************
Private Function Recherche(P As Range, Valeur)
Dim C As Range, T, Adresse1 As String, i As Long, T2
i = 0
With P
Set C = .Find(Valeur, , xlValues)
If Not C Is Nothing Then
ReDim T(3, i)
ReDim T2(3, i)
Adresse1 = C.Address
Do
With C
'Test peut être inutile
' If .Offset(0, ColDom - .Column) = "Domicile" Then
T(0, i) = VBA.Format(.Offset(0, ColDate - .Column).Text, "mm/dd/yy") 'date
T(1, i) = .Offset(0, ColHor - .Column).Text 'Horaire
T(2, i) = .Offset(0, ColCat - .Column).Text 'Categorie
T(3, i) = .Column
T2(0, i) = .Offset(0, ColDate - .Column) ' Date numerique
T2(1, i) = .Offset(0, ColDate - .Column) ' Horaire numerique
i = i + 1
ReDim Preserve T(3, i)
ReDim Preserve T2(3, i)
' End If
End With
Set C = .FindNext(C)
Loop While Not C Is Nothing And C.Address <> Adresse1
End If
End With
T = Triertable(T, i, T2)
Recherche = T
End Function

'**************************************
Sub Bouton8_QuandClic()
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
Princ
End Sub
'**************************************
Function Triertable(T, Maxi As Long, T2)
Dim i, j As Long, tmpstr As String, tmpnum
If Maxi > 1 Then
For i = Maxi - 1 To 0
For j = 0 To i
If T2(0, j + 1) & T2(1, j + 1) < T2(0, j) & T2(1, j) Then
tmpnum = T2(0, j)
T2(0, j) = T2(0, j + 1)
T2(0, j + 1) = tmpnum
tmpnum = T2(1, j)
T2(1, j) = T2(1, j + 1)
T2(1, j + 1) = tmpnum
tmpstr = T(0, j)
T(0, j) = T(0, j + 1)
T(0, j + 1) = tmpstr
tmpstr = T(1, j)
T(1, j) = T(1, j + 1)
T(1, j + 1) = tmpstr
tmpstr = T(2, j)
T(2, j) = T(2, j + 1)
T(2, j + 1) = tmpstr
tmpstr = T(3, j)
T(3, j) = T(3, j + 1)
T(3, j + 1) = tmpstr
End If
Next j
Next i
End If
Triertable = T
End Function
'**************************************