VBA simple

Pat -  
Bonjour,
Voila, je en connais pas grand chose en VBA, cependant je voudrait faire un petit macro.
Je voudrais que mon macro vérifie la colonne "M12 à T65" (les cellule sont fusionnée sur 2 de haut et 8 de large) donc il s'agit bien de 1 seul colonne.
Si il voit inscrit "Diminution" alors il doit inscrire une formule [=SI(AG14="";"";(60-(60/(RECHERCHEV(B14;$L$3:$BC$8;41;FAUX)/AG14)))/(60/AJ14))]
cette formule est a inscrire dans la colonne "AL12 à AM65 (pareillement il sagit bien d'une seul colonne les cellule sont fusionnée par deux de large et par deux de haut).
Dernier détail le macro fonctionnera sur une feuille partiellement verouillée et je voudrais ne pas devoir appuyer sur un bouton pour activer le macro il faut qu'il s'active en permanenece apres avoir écrit en colonne "M"
si vous pouvier me laisser un max de commentaire sur le macro ca m'aiderait pour mon apprentissage

Merci d'avance a celui qui se penchera sur mon problème.

10 réponses

  1.  jordane45 Modérateur
    Bonjour,

    déjà :

    ne pas devoir appuyer sur un bouton pour activer le macro il faut qu'il s'active en permanenece apres avoir écrit en colonne "M"

    Regarde la méthode 
    Private Sub Worksheet_Change(ByVal Target As Range)

End Sub


    L'objet target étant la cellule (ou plage de cellules) modifiées.
    Et pour cibler la colonne M 
    If Not Application.Intersect(Target, Range("M:M")) Is Nothing Then
  'Tu es en colonne "M"
   ligne = target.Row 'ligne où tu te trouves
   
   '... le reste de ton code


End If


    Il ne te reste plus qu'à faire un IF pour tester ta condition et à écrire la formule à la colonne souhaitée.

    NB: Pour écrire une formule regarde la propriété : formulalocal

    1. Pat
      Super sympa, cependant c'est le premier code que je vais essayer de faire moi même alors la du coup je sus paumé.
      Bon j'ai fait click droit sur ma feuille puis cliquer sur visualiser le code.
      Ensuit j'ai choisis "Worksheet"
      et la voila mon code :
      Private Sub Worksheet_SelectionChange(ByVal Target As Range)

      If Not Application.Intersect(Target, Range("M12:M65")) Is Nothing Then

      ="Diminution_de_vitesse"

      ligne = Target.Row

      Range("AL12:AL65") =SI(AG12="";"";(60-(60/(RECHERCHEV(B12;$L$3:$BC$8;41;FAUX)/AG12)))/(60/AJ12))
      End If
      End Sub

      Evidement rien ne fonctionne
      Il me faut un gros gros éclaircissement SVP

      En clair je me debrouille parfaitement avec les formule mais la partie VBA la j'ai tout a apprendre

      Merci d'avance
      1. jordane45 Modérateur
        Déjà...Pour poster du code sur le forum.. merci d'utiliser la coloration syntaxique (les balises de code).
        Explications disponibles ici : https://codes-sources.commentcamarche.net/faq/10686-le-nouveau-codes-sources-comment-ca-marche#balises-code

        Ensuite,

        et la voila mon code :
        Private Sub Worksheet_SelectionChange(ByVal Target As Range)

        hors.. moi je t'ai indiqué : 
        Sub Worksheet_Change


        Et puis.. ton code devrait ressembler à un truc du genre 
        Private Sub Worksheet_Change(ByVal Target As Range)

If Not Application.Intersect(Target, Range("M12:M65")) Is Nothing Then

   if Target.Value ="Diminution_de_vitesse" Then
             ligne = Target.Row

            cells(ligne,"AL").formulalocal =  "=SI(AG" & ligne  & ="""";"""";(60-(60/(RECHERCHEV(B" & ligne & ";$L$3:$BC$8;41;FAUX)/AG" & lilgne & ")))/(60/A" & ligne & "))"
    End If 
End If
End Sub


        A voir au niveau des guilllemets si j'ai mis le bon nombre.. j'ai codé de tête
    2. Pat
      Génial Mec tu est un vrai petit génie!!

      Effectivement problème de guillement c'est corrigé

      Il me reste un dernier problème le code fonctionne bien et ce sur chaque ligne de la sélection. par contre ma formule ne s'étire pas elle reste figée

      Or pour moi il faudrait quelle soit évolutive pour les partie mise en gras
      12 quand ligne 12
      14 quand ligne 14
      16 quand ligne 16
      .....
      =SI(AG12="";"";(60-(60/(RECHERCHEV(B12;$L$3:$BC$8;41;FAUX)/AG12)))/(60/AJ12)) 

      Private Sub Worksheet_Change(ByVal Target As Range)

      If Not Application.Intersect(Target, Range("M12:M65")) Is Nothing Then

         If Target.Value = "Diminution_de_vitesse" Then
                   ligne = Target.Row

                  Cells(ligne, "AL").FormulaLocal = "=SI(AG12="""";"""";(60-(60/(RECHERCHEV(B12;$L$3:$BC$8;41;FAUX)/AG12)))/(60/AJ12))"
          End If
      End If

      End Sub

      1.  jordane45 Modérateur
        C'est ce que j'avais fait avec la concaténation de la variable ligne..
    3. Pat
      Re bonjour,
      Et encore merci a toi jordane45
      Ehhhhh ... j'ai pas bien compri ton dernier message, "C'est ce que j'avais fait avec la concaténation de la variable ligne.." c'est a dire??

      car j'ai fait le test et quelle que soit la ligne il me laisse la même formule.
      Y a t-il une astuce qui permetterais d'adapter la formule en fonction de la ligne?

      Ou je suis obliger de créer un macro par ligne?
      1. jordane45 Modérateur
        Je t'avais donné la ligne de code : 
        cells(ligne,"AL").formulalocal =  "=SI(AG" & ligne  & ="""";"""";(60-(60/(RECHERCHEV(B" & ligne & ";$L$3:$BC$8;41;FAUX)/AG" & lilgne & ")))/(60/A" & ligne & "))"


        Alors que toi tu as remis : 
         Cells(ligne, "AL").FormulaLocal = "=SI(AG12="""";"""";(60-(60/(RECHERCHEV(B12;$L$3:$BC$8;41;FAUX)/AG12)))/(60/AJ12))"

        Ne vois tu pas la différence ???
    5. Pat
      Pardon,
      Effectivement je vois bien la différence.

      Je te remercie de ta patience, je vien de trouver pourquoi la tienne ne fonctionnait pas non plus et voici le résultat 

      cells(ligne,"AL").formulalocal =  "=SI(AG" & ligne  & ="""";"""";(60-(60/(RECHERCHEV(B" & ligne & ";$L$3:$BC$8;41;FAUX)/AG" & lilgne & ")))/(60/A" & ligne & "))"


      Cells(ligne, "AL").FormulaLocal = "=SI(AG" & ligne & "="""";"""";(60-(60/(RECHERCHEV(B" & ligne & ";$L$3:$BC$8;41;FAUX)/AG" & ligne & ")))/(60/AJ" & ligne & "))"


      1 manque 1 guillement
      2 lilgne au lien de ligne
      3 A au lieu de AJ

      Encore un tout grand merci!!

      Globalement je commence un petit peu a comprendre je vais analyser ce code point par point et verrais si il y a des chose a comprendre

      Merciiiiiiiiii
      1. pat
        Bonsoir,
        Je fait des heures supp la afin d'essyer de cloturer ma base de donnée pour ce lundi. et je constate deux petit bug dans notre VBA.

        1 Le premier est que si la personne qui encode place en colonne "M" diminution de vitesse (via une liste validation de donnée) "Diminution_de_vitesse" et puis pour finir il change d'avis et selectionne autre chose la formule reste dans la colonne "AL"

        2 deuxième qui est plus embètant encore, une fois que toutes les donnée sont encodée dans le formulaire, j'ai créer un petit macro qui va les sauvegarder sur une autre page (c'est ok ) et qui pour finir va vider le formulaire (un simple delete) et lorsque l'on fait un Delete en colonne "M" gros bug et voici la ligne qui est ciblée lors du bug : (erreur d'exécution 13) 

        If Target.Value = "Diminution_de_vitesse" Then


        Alors avez vous encore une idée pour ce petit réglage?

        Encore une fois merci d'avance
        1. jordane45 Modérateur
          Pour le 1 .. il suffit de mettre un ELSE dans lelquel tu fixes la valeurs de la cellule à vide ( ="")

          Et pour le 2 ... il faux boucler sur chaque cellule de la plage correpodnant à l'intersection de la target de de la plage que tu as fixé

          par exemple : 
          Private Sub Worksheet_Change(ByVal Target As Range)
Dim workRng As Range

Set workRng = Application.Intersect(Target, Range("M12:M65"))

If Not workRng Is Nothing Then

    For Each C In workRng
    
     ligne = C.Row
        If C.Value = "Diminution_de_vitesse" Then
            
             ' le reste de ton code
             '
             '
             '

        Else
            Range("AL" & ligne).Value = ""
        End If
    Next
End If
End Sub
      2. pat
        Bonsoir Jordane,
        Encore une fois merci pour ton code qui fonctionne parfaitement!!

        Je commence un peut a comprendre certaine partie des code VBA et grace a toi j'ai reussi a "doubler" le code et ca fonctionne parfaitement!!

        Bon par contre quand j'essaye d'ajouter un 3ème et que j'active la conditio, excel plante completement.

        Voici ce que j'essaye d'intégrer just avant le end sub final 

        If [F3] <> "" Then
        [F43] = "=SI(OU(JOURSEM(F3;1)=2;JOURSEM(F3;1)=3;JOURSEM(F3;1)=4;JOURSEM(F3;1)=5);8;SI(JOURSEM(F3;1)=6;6;"à compléter"))"
        Else
        [F43] = ""
        End If


        et voici le code complet 

        Private Sub Worksheet_Change(ByVal Target As Range)
            
            'Mise en place de la formule en colone AL si il fait ecrit diminution de vitesse en colone M
            
        Dim workRng As Range

        Set workRng = Application.Intersect(Target, Range("M12:M65"))

        If Not workRng Is Nothing Then

            For Each C In workRng
            
             ligne = C.Row
                If C.Value = "Diminution_de_vitesse" Then
                    ligne = Target.Row

                    Cells(ligne, "AL").FormulaLocal = "=SI(AG" & ligne & "="""";"""";(60-(60/(RECHERCHEV(B" & ligne & ";$L$3:$BC$8;41;FAUX)/AG" & ligne & ")))/(60/AJ" & ligne & "))"

                Else
                    Range("AL" & ligne).Value = ""
                End If
            Next
        End If

            'Mise en place de la formule en colone AN si il fait ecrit "nimporte quoi" en colone F

        Set workRng = Application.Intersect(Target, Range("F12:f65"))

        If Not workRng Is Nothing Then

            For Each C In workRng
            
             ligne = C.Row
                If C.Value <> "" Then
                    ligne = Target.Row

                    Cells(ligne, "AN").FormulaLocal = "=SI(F12<>"""";1;"""")"

                Else
                    Range("AN" & ligne).Value = ""
                End If
            Next
        End If

            'Mise en place de la formule F8 si "quelque chose" en F3

        End Sub

        1.  jordane45 Modérateur
          Ca plante sur quel ligne ?
          tu as essayé de mettre un point d'arrêt dans ton code puis de l'exécuter en mode pas à pas ?

          Et puis.. tu écris : 
            Cells(ligne, "AN")

          Hors.. il me semble que ça ne fonctionne pas. (j'ai fait une erreur dans mon premier message)
          C'est pour ça que j'ai modifié ensuite dans le code que je t'ai donné en : 
           Range("AN" & ligne)
      3. pat
        Ehh et bien pourtant lorsque j'utiliste le "code complet" comme je viens de l'envoyer ca fonctionne parfaitement chez moi.

        La ou ca bug c'est quand je rajoute la 3 eme condition :

        Je la place just avant le end sub final, lorsque je le place il me met cette ligne en rouge : 

        [F43] = "=SI(OU(JOURSEM(F3;1)=2;JOURSEM(F3;1)=3;JOURSEM(F3;1)=4;JOURSEM(F3;1)=5);8;SI(JOURSEM(F3;1)=6;6;"à compléter"))"


        et puis je quite le vba je change la valeur en F3 et la boummmm ca bug complètement,je ne sait pas ou, car excel plante complètement. 

        If [F3] <> "" Then
        [F43] = "=SI(OU(JOURSEM(F3;1)=2;JOURSEM(F3;1)=3;JOURSEM(F3;1)=4;JOURSEM(F3;1)=5);8;SI(JOURSEM(F3;1)=6;6;"à compléter"))"
        Else
        [F43] = ""
        End If


        Et quand tu parle de point d'arret et de "pas a pas" ca me dit rien j'ai jamais entendu parler de ca :s

        Encore merci de ta patience mec ;)
        1. jordane45 Modérateur
          https://www.commentcamarche.net/contents/1381-debogage
      4. pat
        Bonsoir,
        Merci pour ces infos très utiles.
        Je viens de tester le "pas a pas" et voici sur quelle ligne le code plante : 

        [F43] = "=SI(OU(JOURSEM(F3;1)=2;JOURSEM(F3;1)=3;JOURSEM(F3;1)=4;JOURSEM(F3;1)=5);8;SI(JOURSEM(F3;1)=6;6;""à compléter""))"


        Erreur d'exécution '1004':
        Erreur définie par l'application ou par l'objet.

        Personnellement ca m'aide pas plus mais j'espere que tu va pouvoir m'éclairer encore une fois

        Merci a toi (encore une fois :) )
        1. pat
          Ehh pardon je dit que ca ne m'a pas aider mai en réalité j'ai réussi a faire passer la ligne de couleur "rouge" en couleur jaune c'est un début :D

          la première erreur était : 
          "à compléter"

          Au lieu de 
          ""à compléter""

          Discussions similaires

          Méthode find dans VBA - Recherche de données sous Excel
          baissaoui

          0 réponse
          erreur d'execution 9, l'indice n'appartient pas à la sélection
          isidoh

          18 réponses
          "L'indice n'appartient à la sélection" + VBA
          fleur.31

          2 réponses