InputBox avec remplissage aléatoire

Bonjour à tous,

Je suis nouvelle sur le Forum et plutôt assez novice en VBA mais je m'améliore de jour en jour grâce au forum.

Voici mon cas pour lequel je n'ai pas trouvé de réponse :

J'ai une colonne avec des écarts sur un fichier initial qui fait plus de 5000 lignes.

Une colonne avec un 1 si l'écart est une anomalie à justifier par un manager

Je souhaiterai pouvoir attribuer ces écarts à des managers de manière aléatoire afin qu'ils puissent justifier l'anomalie.

Aujourd'hui je sors de mon traitement VBA à cet instant et réalise cette manip dans EXCEL (manuellement)

Le nombre d'écart est variable (comptage réalisé grâce aux 1)

Le nombre d'ecart par personne doit être proportionnel. (Nombre d'ecart/Nombre de managers) mais doit être arrondi à l'entier

Le nombre de managers l'est également (maximum 15) (Input-Box pour donner le nombre puis Nombre d' Input-Box en fonction pour rentrer les Initiales des managers.

Ensuite comment remplacer ma valeur "initiales à mettre" par ces Initiales de managers rentrés en InputBOX selon le nombre d'ecart par personne

Dans l'exemple joint (2 onglets = Initial et résultat attendu)

Mon exemple devrait contenir 4 input box : avec les valeurs suivantes remplies :

Nombre de managers = 3

3 input ensuite pour mettre les 3 initiales

19 Ecarts et donc forcément 1 non attribué

Voici le début de ma VBA : (qui ne fait absoluement rien )

Sub TEST()
'
' TEST Macro
'

'
Dim NOMBRE_ECART As Variant
Dim nombre_ecart_par_personne As Variant
Dim nombre_de_managers
Dim Manager1 As Variant
Dim Manager2 As Variant

Set ECARTS = Range("A2:A100")
NOMBRE_ECART = Application.WorksheetFunction.Sum(ECARTS)
nombre_de_managers = InputBox("Saisir le nombre de managers pour justif", Nbmanager)
nombre_ecart_par_personne = (NOMBRE_ECART / nombre_de_managers)
Manager1 = InputBox("Saisir les Initiales du 1er Manager en Justif :", MANAGER_1)
Manager2 = InputBox("Saisir les Initiales du 2ème Manager en Justif :", MANAGER_2)

Range("B2:B100").Select

For I = 1 To nombre_ecart_par_personne
If ActiveCell.Value = "INITIALES A METTRE" Then ActiveCell.Value = Replace("INITIALES A METTRE", "INITIALES A METTRE", Manager1, 1)
Next I
For I = 1 To nombre_ecart_par_personne
If ActiveCell.Value = "INITIALES A METTRE" Then ActiveCell.Value = Replace("INITIALES A METTRE", "INITIALES A METTRE", Manager2, 1)
Next I

End Sub

MERCI A TOUS POUR VOTRE AIDE

Bonjour Chris et bienvenue, bonjour le forum,

Peut-être comme ça :

Sub Macro1()
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable J (incrément)
Dim K As Integer 'déclare la variable K (incrément)
Dim TL() As Variant 'déclare la variable TL (Tableau des Lignes)
Dim NE As Integer 'déclare la variable NE (Nombre d'Ecarts)
Dim NM As Variant 'déclare la variable NM (Nombre de Managers)
Dim TIM() As Variant 'déclare la variable TIM (Tableau des Initiales des Managers)
Dim NPM As Integer 'déclare la variable NPE (Nombre Par Manager)

Set O = Worksheets("Initial") 'définit l'onglet O
TV = O.Range("A1").CurrentRegion 'définit le tableau des valeurs TV
K = 1 'initialise la variable K
For I = 2 To UBound(TV, 1) 'boucle sur toutes les ligne I du tableau des valeurs (en partant de la seconde)
    If TV(I, 2) = 1 Then 'condition : si la donnée ligne I colonne 2 de TV est égale à 1
        ReDim Preserve TL(1 To K) 'redimensionne le tableau des ligne TL
        TL(K) = I 'récupère le numéro de la ligne I
        K = K + 1 'incrémente K
    End If 'fin de la condition
Next I 'prochaine ligne de la boucle
NE = Application.WorksheetFunction.SumIf(Columns(2), 1) 'définit le nombre d'écarts NE
MsgBox "il y a  " & NE & " écarts à justifer." 'message
ici1: 'étiquette
NM = Application.InputBox("Saisir le nombre de managers pour justif.", Type:=1) 'définit le nombre de managers NM
If NM = False Or NM = "" Then Exit Sub 'si bouton [Annuler] ou non renseignée, sort de la procédure
If NM > 15 Then 'condition "si le nombre de managers est supérieur à 15
    MsgBox "Le nombre maximum de managers est de 15 !" 'message
    GoTo ici1 'va à l'étiquette "ici1"
End If 'fin de la condition
ReDim TIM(1 To NM) 'redimentionne le tableau TIM des intiales des managers (autant de lignes qu'il y a de managers)
For I = 1 To NM 'boucle 1 : sur le nombre de managers, de 1 à NM
ici2: 'étiquette
    TIM(I) = UCase(Application.InputBox("Initiales du manager " & I, "INITIALES", Type:=2)) 'définit l'initiale du manager de la boucle (convertie en majuscules)
    For J = 1 To UBound(TIM) 'boucle 2 : sur le nombre d'éléments du tableau TIM des Initiales des managers
        If I <> J And TIM(I) = TIM(J) Then 'condition : si I est différent de J et que les initiales sont identiques
            MsgBox "Ces intiales sont déjà utlisées ! Vous devez en changer." 'message
            GoTo ici2 'va à l'étiquette "ici2"
        End If 'fin de la condition
    Next J 'prochain élément de la boucle 2
Next I 'prochain manager de la boucle 1
NPM = Round(NE / NM, 0) 'définit le nombre d'écarts par manager NPM
K = 1 'initialise la variable K
For J = 1 To NPM 'boucle 1 : sur le nombre d'écarts par manager, de 1 a NPM
    For I = 1 To UBound(TL) 'boucle 2 : sur toutes les lignes ayant un écart à justifier
        O.Cells(TL(I), 3) = TIM(K) 'renvoie dans la cellule ligne (TL(J) colonne 3, les initiales TIM(K)
        K = K + 1: If K > NM Then K = 1 'incrémente K et si K est supérieure au nombre de managers NM alors K redevient égale à 1
    Next I 'prochaine ligne de la boucle 2
Next J 'prochain manager de la boucle 1
End Sub

Bonjour CHRIS78550, ThauThème,

une autre solution:

Sub TESTBOUCLE1()
'
Dim nombre_de_managers, x As Integer
Dim Manager 'tableau des initiales des managers

nombre_de_managers = InputBox("Saisir le nombre de managers pour justif", Nbmanager)
If nombre_de_managers = "" Then Exit Sub

ReDim Manager(1 To nombre_de_managers)

For i = 1 To nombre_de_managers
    While Manager(i) = ""
        Manager(i) = InputBox("Saisir les Initiales du Manager " & i & " en Justif :", "Manager " & i)
    Wend
Next

For i = 1 To Range("B" & Rows.Count).End(xlUp).Row 'de la première à la dernière ligne
    If Range("B" & i) = 1 Then
        x = x + 1
        If x > UBound(Manager) Then x = 1
        Range("C" & i) = Manager(x)
    End If
Next i

End Sub

après détermination du nombre et des initiales des managers, on parcours la colonne B;pour chaque cellule contenant 1 on copie les initiales des manager suivant la liste des managers. Dans ces conditions, chaque manager aura sensiblement le même nombre d'anomalie.

A+

Re,

Pas vraiment une autre solution mais en tout cas tellement plus simple !... Bravo !