Sub creation_tableau()
'Programme réalisé par ODESTA pour la création d'équipes
Dim tableau_CA(20, 1) '0,0 est le nombre de ligne i,0 le nom i,1 le nombre d'intervention
'0,1 la personne de la semaine précédent le remplissage
Dim tableau_CDT(20, 1)
Dim tableau_Equipier(100, 2)
'Création des tableaux en fonction des noms (attention à ne pas dépasser 20 pour CA et CDT et 100 pour Equipier)
ligne = 2
i = 1
While Cells(ligne, 1).Value <> ""
tableau_CA(i, 0) = Cells(ligne, 1).Value
i = i + 1
ligne = ligne + 1
Wend
tableau_CA(0, 0) = ligne - 1 - 1 'pensez à supprimer le ligne titre et la ligne en trop du à la fonction while
ligne = 2
i = 1
While Cells(ligne, 2).Value <> ""
tableau_CDT(i, 0) = Cells(ligne, 2).Value
i = i + 1
ligne = ligne + 1
Wend
tableau_CDT(0, 0) = ligne - 1 - 1
ligne = 2
i = 1
While Cells(ligne, 3).Value <> ""
tableau_Equipier(i, 0) = Cells(ligne, 3).Value
i = i + 1
ligne = ligne + 1
Wend
tableau_Equipier(0, 0) = ligne - 1 - 1
'récupération des lignes déja renseignées
For i = 2 To 54
' CA
If Cells(i, 6).Value <> "" Then
valeur = Cells(i, 6).Value
For j = 1 To tableau_CA(0, 0)
If tableau_CA(j, 0) = valeur Then
tableau_CA(j, 1) = tableau_CA(j, 1) + 1
End If
Next
End If
' CDT
If Cells(i, 7).Value <> "" Then
valeur = Cells(i, 7).Value
For j = 1 To tableau_CDT(0, 0)
If tableau_CDT(j, 0) = valeur Then
tableau_CDT(j, 1) = tableau_CDT(j, 1) + 1
End If
Next
End If
' Equipier
If Cells(i, 8).Value <> "" Then
valeur = Cells(i, 8).Value
For j = 1 To tableau_Equipier(0, 0)
If tableau_Equipier(j, 0) = valeur Then
tableau_Equipier(j, 1) = tableau_Equipier(j, 1) + 1
End If
Next
End If
If Cells(i, 9).Value <> "" Then
valeur = Cells(i, 9).Value
For j = 1 To tableau_Equipier(0, 0)
If tableau_Equipier(j, 0) = valeur Then
tableau_Equipier(j, 1) = tableau_Equipier(j, 1) + 1
End If
Next
End If
Next
'création des lignes
'récupération de la semaine en cours (pour ne pas avoir de répétition)
ligne = 2
If Cells(6, 2).Value = "" Then
'si tableau vide
Else 'si tableau deja remplis en partie
While Cells(ligne, 6).Value <> "" And ligne < 55
ligne = ligne + 1
Wend
tableau_CA(0, 1) = Cells(ligne - 1, 6).Value
tableau_CDT(0, 1) = Cells(ligne - 1, 7).Value
tableau_Equipier(0, 1) = Cells(ligne - 1, 8).Value
tableau_Equipier(0, 2) = Cells(ligne - 1, 9).Value
End If
For i = 2 To 54
'CA
CA_min = 54
If Cells(i, 6).Value = "" Then
'récupéré le CA ayant intervenu le moins...
For j = 1 To tableau_CA(0, 0)
If tableau_CA(j, 0) <> tableau_CA(0, 1) And tableau_CA(j, 1) < CA_min Then '...et différent de celui de la semaine précédente
CA_min = tableau_CA(j, 1)
Position = j
End If
Next
Cells(i, 6).Value = tableau_CA(Position, 0)
tableau_CA(Position, 1) = tableau_CA(Position, 1) + 1
tableau_CA(0, 1) = tableau_CA(Position, 0)
End If
'CDT
CA_min = 54
If Cells(i, 7).Value = "" Then
'récupéré le CDT ayant intervenu le moins...
For j = 1 To tableau_CDT(0, 0)
If tableau_CDT(j, 0) <> tableau_CDT(0, 1) And tableau_CDT(j, 1) < CA_min Then '...et différent de celui de la semaine précédente
CA_min = tableau_CDT(j, 1)
Position = j
End If
Next
Cells(i, 7).Value = tableau_CDT(Position, 0)
tableau_CDT(Position, 1) = tableau_CDT(Position, 1) + 1
tableau_CDT(0, 1) = tableau_CDT(Position, 0)
End If
'Equipier 1
CA_min = 54
If Cells(i, 8).Value = "" Then
'récupéré le CDT ayant intervenu le moins...
For j = 1 To tableau_Equipier(0, 0)
If tableau_Equipier(j, 0) <> tableau_Equipier(0, 1) And tableau_Equipier(j, 0) <> tableau_Equipier(0, 2) And tableau_Equipier(j, 1) < CA_min Then '...et différent de celui de la semaine précédente
CA_min = tableau_Equipier(j, 1)
Position = j
End If
Next
Cells(i, 8).Value = tableau_Equipier(Position, 0)
tableau_Equipier(Position, 1) = tableau_Equipier(Position, 1) + 1
tableau_Equipier(0, 1) = tableau_Equipier(Position, 0)
Equipier1 = tableau_Equipier(Position, 0)
End If
'Equipier 2
CA_min = 54
If Cells(i, 9).Value = "" Then
'récupéré le CDT ayant intervenu le moins...
For j = 1 To tableau_Equipier(0, 0)
If tableau_Equipier(j, 0) <> Equipier1 And tableau_Equipier(j, 0) <> tableau_Equipier(0, 1) And tableau_Equipier(j, 0) <> tableau_Equipier(0, 2) And tableau_Equipier(j, 1) < CA_min Then '...et différent de celui de la semaine précédente
CA_min = tableau_Equipier(j, 1)
Position = j
End If
Next
Cells(i, 9).Value = tableau_Equipier(Position, 0)
tableau_Equipier(Position, 1) = tableau_Equipier(Position, 1) + 1
tableau_Equipier(0, 1) = tableau_Equipier(Position, 0)
End If
Next
End Sub