mettre un 1 dans une colonne

Kiphrine

XLDnaute Nouveau
Bonjour, forum,
j'aurais besion de votre aide pur un petit problème de code et d'insertion,
voilà mon code
Code:
Sub Nom_FIP_3(w() As String)

Dim v As Byte, c As New Collection, x As Integer, y() As Variant, z() As Variant, i As Byte

Randomize
y = Array(16, 17, 18)
z = Array(9, 25, 42)
For i = 0 To 2
    Do While c.Count < 3
        cpt% = cpt% + 1
        If cpt% > MAX_ITER Then
          cpt% = 0
          Exit Do
        End If
        x = Int(y(i) * Rnd + z(i))
        If Cells(x, 3) = 1 And Cells(x, 3).Interior.ColorIndex <> 3 Then
            On Error Resume Next
            c.Add Cells(x, 3).Address, CStr(Cells(x, 3).Address)
            If Err = 0 Then If Err = 0 Then Cells(x, 11) = "1"
                On Error GoTo 0
                w(v) = Cells(x, 2).Value
                v = v + 1
            End If
            On Error GoTo 0
        End If
    Loop
    Set c = Nothing
Next i
 
End Sub

Sub FIP_AIP_MUSC_3()

Dim p As Range, v As Byte, w(9) As String
 
Nom_FIP_3 w
 
For Each p In Sheets("Mois en cours").Range("F4:F18")
    If p.Interior.ColorIndex <> 6 And IsEmpty(p.Value) Then
       p.Value = w(0)
       For v = 1 To UBound(w)
           p.Value = p.Value & "/" & w(v)
       Next v
    End If
Next p
 
Nom_FIP_3 w
 
For Each p In Sheets("Mois en cours").Range("F19:F34")
    If p.Interior.ColorIndex <> 6 And IsEmpty(p.Value) Then
       p.Value = w(0)
       For v = 1 To UBound(w)
           p.Value = p.Value & "/" & w(v)
       Next v
    End If
Next p
 
End Sub

J'aimerais insérer un code qui dit ceci:
Regarder dans la colonne K, si la cellule est vide alors y inscrire un 1, si elle n'est pas vide alors prendre une vide"
Merci
 

Kiphrine

XLDnaute Nouveau
Problème de planning

Bonjour, je fais un planning sous excel mais un problème est survenu lors de sa création:
en ligne: les jours
en colonne les activités
Mon code met plusieurs personnes dans une activité pour un jour.
Le problème est qu'il me répète les personnes d'une activité à l'autre pour un même jour or une personne ne peut faire qu'une activité par jour.
Je ne vois pas comment régler mon problème.
Quelqu'un pourrait-il m'aider?
Je joindrait mon fichier à la demande avec des explications supplémentaires.
 

Kiphrine

XLDnaute Nouveau
Re : Problème de planning

Voici le fichier.
Le code se trouve dans le module roulement.
Mon code prend les agents dans la feuille"compétence" qui ne sont pas en rouge et qui possède un 1 puis les met dans la feuille"mois en cours" sauf dans les cellules jaunes.
Les même agents restent en place 15 jours et changent pour les 15 autres jours.
Le planning s'affiche en cliquant sur le bouton 'nombre de restes voulus' et en indiquant un chiffre<100.
N'hésite pas à poser plus de question si tu ne comprend pas quelque chose et merci beaucoup à toi de prendre le temps de regarder mon problème.:)
 

Pièces jointes

  • panning.zip
    42.9 KB · Affichages: 35

Kiphrine

XLDnaute Nouveau
Re : Problème de planning

N'hésitez pas à me demander ce que vous ne comprenez pas.
En fait je ne sais pas si l'idée de mettre des 1 dans une colonne était bonne donc je redemande si il n'y aurait pas une autre solution.
J'ai vraiment besoin d'une solution car c'est un projet qui me permettra de valider mon stage.
 
Dernière édition:

sbso

XLDnaute Nouveau
Re : mettre un 1 dans une colonne

POUR COMPLETER LE SUJET
Après avoir donner la solution pour mettre des 1 dans une colonnes, je supposes que tu vas être amener à mettre une formule dans toute une colonne.
Mais ce n'est qu'une suggestion
 

Kiphrine

XLDnaute Nouveau
Re : mettre un 1 dans une colonne

Le problème est que je ne sais pas si mettre en 1 dans une colonne était possible avec mon code car au lieu de prendre les colonnes une par une il les prend en un seul coup. Donc si quelqu'un aurait une autre solution, j'avoue que je suis preneuse!:)
 

Alyrio

XLDnaute Nouveau
Re : mettre un 1 dans une colonne

Bonjour Kiphrine, le forum

une solution me semble-t-il serait de sélectionner la procédure"SelectionChange" dans la feuille "compétences" et de mettre le code suivant :
Code:
Private Sub [b]Worksheet_SelectionChange(ByVal Target As Range)[/b]

    If Target.Value = 1 And Target.Interior.ColorIndex <> 3 Then
           Range("K" & CStr(Target.Row)) = 1
    Else
        
    End If

End Sub
bon courage !!
 
Dernière édition:

Kiphrine

XLDnaute Nouveau
Re : mettre un 1 dans une colonne

Merci de ta réponse Alyro, mais ceci non plus ne semble pas fonctionner non plus. Je viens de penser à quelque chose: ne serait-il pas possible de changer mon code en utilisant les valeurs booleennes?
Dire pour la première activité: "quand agents sélectionnées alors mettre leur valeur en FALSE" et pour les autres activités :"ne prendre que les agents qui sont encore TRUE?"
Je pense que cela pourrais fonctionner, le problème est que je ne sais pas où insérer ces critères dans mon programme.
Si quelqu'un pourrait à nouveau y jetter un coup d'oeuil...
Merci d'avance.
 

Kiphrine

XLDnaute Nouveau
Re : mettre un 1 dans une colonne

Toujours besoin d'aide...
Pour Roger: pour le plantage de la ligne il ne faut pas en tenir compte, ici c'est pour l'impression et cela fonctionne très bien chez moi.
Le problème est dans le module roulement1.
1 agent ne doit apparaître qu'une fois par jour or dans mon code il se répète 2 voir 3 fois.
 
Dernière édition:

Kiphrine

XLDnaute Nouveau
Re : mettre un 1 dans une colonne

Voici mon code:

Code:
Sub Nom_FIP_1(w() As String)
 
Dim v As Byte, c As New Collection, x As Integer, y() As Variant, z() As Variant, i As Byte
Dim agentdisponible() As Boolean ''''''''''''''''''''''''''''
ReDim agentdisponible(nbragent) ''''''''''''''''''''''''''''''
 
Randomize
y = Array(16, 17, 18) 'prendre des agents des lignes 9 à 25, 26 à 34 et 35 à 59
z = Array(9, 25, 42)
For i = 1 To nbragent '''''''''''''''''''''''''''''
agentdisponible(i) = False ''''''''''''''''''''''''''
For i = 0 To 2
    Do While c.Count < 4 ' en prendre 4 dans chaque lignes sélectionnée précédemment
        cpt% = cpt% + 1
        If cpt% > MAX_ITER Then
          cpt% = 0
          Exit Do
        End If
        x = Int(y(i) * Rnd + z(i))
        If Cells(x, 3) = 1 And Cells(x, 3).Interior.ColorIndex <> 3 Then' les prendre si les cellules contiennent des 1 et ne sont pas rouges
            On Error Resume Next
            c.Add Cells(x, 3).Address, CStr(Cells(x, 3).Address)
            If Err = 0 Then
                On Error GoTo 0
                w(v) = Cells(x, 2).Value ' prendre les cellules de la colonne B
                agentdisponible(x) = True ''''''''''''''''''''''''
                v = v + 1
            End If
            On Error GoTo 0
        End If
    Loop
    Set c = Nothing
Next i
Next i ''''''''''''''''''''''''''''''''''
 
End Sub

Les passages que j'ai rajouté et qui ne marchent pas sont mis comme ceci:'''''''''''''
Voilà ce que j'aimerais faire: quand les cellules répondent aux critères( pas rouges et contenant des 1) et sont sélectionnés par le tirage alors les mettre en TRUE.
et dire au programme de prendre au début de chaque tirage que les cellules étant FALSE.
Mais ce que j'ai mis dans le code ne marche pas et je n'arrive pas à tout compléter.
Merci de m'aider.
 

Discussions similaires

Statistiques des forums

Discussions
312 161
Messages
2 085 843
Membres
103 003
dernier inscrit
Maxmarie14