VBA Remplir cellule sur critères

Bonjour,

J'ai besoin de votre aide pour une macro.

1. Pourriez vous me corriger le code suivant svp (désolé d'avoir massacré le VBA).

Private Sub CommandButton5_Click()

Dim Cel As Range, Cel1 As Range
    Set Cel = Range("Q2:Q" & Range("K65536").End(xlUp).Row)
    
For Each Cel1 In Cel
    If Cel1 = "." Then
    Cel1.EntireRow.Delete
End If
Next

For Each Cel1 In Cel
    If Cel1 Like ("eft*" Or "bank*" Or "pin*" Or "cc*" Or "91*") Then
    Cel1 = "COLLECTED"
End If
Next

For Each Cel1 In Cel
    If Cel1 Like ("q*" Or "over*" Or "log*" Or "cust*" Or "cas*" Or "impnd*") Then
    Cel1 = "AFODT SSC"
End If
Next

End Sub


2. Pourriez vous y ajouter en dernière partie:

si cel1 est un blank et si la cellule (cel1.row. en colonne F) = "NCOP"
alors Cel1 = "88888"

si cel1 est un blank et si la cellule (cel1.row. en colonne F) <> "NCOP"
alors Cel1 = "COLLECTED"

Merci d'avance.

18 réponses

  1. Contributeur
    bonjour
    If Cel1 Like ("eft*" Or "bank*" Or ....
    if cel1 like "eft* or cel1 like "bank*" or.....
    

    if(isempty(cel1) then
        if(cells(cel1.row,"F")="NCOP" then
          cel1="88888"
        else
          cel1="Collected"
        end if
    end if
    0
    1. Bonjour,

      Juste une petite remarque, concernant la suppression des lignes....

      ...
      For Each Cel1 In Cel
          If Cel1 = "." Then
          Cel1.EntireRow.Delete
      End If
      ...
      


      Une suppression de ligne se fait du bas vers le haut....

      Bon courage
      0
      1. Salut Eric,

        Désolé je suis un grand débutant dans VBA et donc je ne pourrai pas trop t'aider par contre j'ai une petite question à te poser puisqu'il me semble que tu maîtrise bien le VBA:

        En fait, pour un petit projet, je dois choisir un client dans une liste déroulante puis valider, par exemple je choisis client 2 et je valide (sur un interface vba). Alors que dans mon fichier excel, on a associé chaque client à une valeur (par exemple la valeur 35 pour le client 2).
        Donc mon souci c'est que j'aimerais que quand je valide par exemple "client2", la valeur qui sera mise dans la cellule est 35 et pas client 2. donc on doit prendre la valeur 35 prédéfinie pour le client 2 et la mettre dans la cellule active.

        Merci d'avance :)
        0
        1. Bonjour,

          tout d'abord merci de vos réponses.

          michel_m le fragment de code que tu m'as fourni ne semble pas correct.

          cousinhub29, je ne comprends pas le sens de ta remarque.

          Pourriez vous m'écrire la code en entier svp.

          Merci.
          0
          1. Bonjour,

            En faisant une seule boucle, et donc en partant du bas vers le haut, ça pourrait donner ceci :

            Private Sub CommandButton5_Click()
            Dim Cel As Range
            Dim DerLig As Long, I As Long
            DerLig = Range("K65536").End(xlUp).Row
             
            For I = DerLig To 2 Step -1
                Set Cel = Cells(I, "Q")
                If Cel = "." Then
                    Cel.EntireRow.Delete
                ElseIf Cel Like "eft*" Or Cel Like "bank*" Or Cel Like "pin*" Or Cel Like "cc*" Or Cel Like "91*" Then
                    Cel = "COLLECTED"
                ElseIf Cel Like "q*" Or Cel Like "over*" Or Cel Like "log*" Or Cel Like "cust*" Or Cel Like "cas*" Or Cel Like "impnd*" Then
                    Cel = "AFODT SSC"
                End If
            Next I
            End Sub
            


            Lorsque tu supprimes des lignes, par exemple la ligne 5, Excel continuera par la 6...
            Or comme tu as supprimé la 5, la ligne 6 est donc maintenant en ligne 5, ce qui fera qu'elle ne sera pas testée...Excel testant maintenant l'ex-ligne 7, devenue ligne 6
            Fais un essai en mettant dans 2 cellules contigües, un point..

            Si tu fais du haut vers le bas, seule la première cellule sera supprimée

            Bon dimanche
            0
            1. Génial Cousinhub, ça fonctionne! Merci pour l'info ;)

              En revanche, il faudrait ignorer la casse... En effet dans mon fichier original, en prenant l'exemple de bank, il peut etre ecrit BANK, Bank ou bank, etc... Et la macro ne considère que bank.

              De plus, pourrais tu y intégrer la condition suivante.
              si cel est un blank et si la cellule (cel1.row. en colonne F) = "NCOP"
              alors Cel = "88888"

              si cel1 est un blank et si la cellule (cel1.row. en colonne F) <> "NCOP"
              alors Cel = "COLLECTED"

              Merci.
              0
              1. Re-,

                En ajoutant Option Compare Text en haut du module, on s'affranchit des minuscules/Majuscules

                Essaie ainsi :

                Option Compare Text
                Private Sub CommandButton5_Click()
                Dim Cel As Range
                Dim DerLig As Long, I As Long
                DerLig = Range("K65536").End(xlUp).Row
                 
                For I = DerLig To 2 Step -1
                    Set Cel = Cells(I, "Q")
                    If Cel = "." Then
                        Cel.EntireRow.Delete
                    ElseIf IsEmpty(Cel) And Cel.Offset(, -11) = "NCOP" Then
                        Cel = 88888
                    ElseIf IsEmpty(Cel) And Cel.Offset(, -11) <> "NCOP" Then
                        Cel = "COLLECTED"
                    ElseIf Cel Like "eft*" Or Cel Like "bank*" Or Cel Like "pin*" Or Cel Like "cc*" Or Cel Like "91*" Then
                        Cel = "COLLECTED"
                    ElseIf Cel Like "q*" Or Cel Like "over*" Or Cel Like "log*" Or Cel Like "cust*" Or Cel Like "cas*" Or Cel Like "impnd*" Then
                        Cel = "AFODT SSC"
                    End If
                Next I
                End Sub
                


                Bonne journée
                0
                1. Quelques précisions:

                  Pour Set Cel = Cells(I, "Q")

                  en fait j'ai ajouté une entête au fichier j'aimerais que la macro travaille à partir de la cellule 7 jusqu'à Range("K65536").End(xlUp).Row

                  L'option Compare text ne fonctionne pas

                  de même que
                  ElseIf IsEmpty(Cel) And Cel.Offset(, -11) = "NCOP" Then
                  Cel = 88888
                  ElseIf IsEmpty(Cel) And Cel.Offset(, -11) <> "NCOP" Then
                  Cel = "COLLECTED"

                  :/
                  0
                  1. Re-,

                    Pour t'arrêter à la ligne 7, tu modifies :

                    For I = DerLig To 2 Step -1
                    


                    par :

                    For I = DerLig To 7 Step -1
                    


                    Ensuite, c'est étonnant que l'option compare text ne fonctionne pas...(j'ai fait des essais, et cela fonctionne chez moi...)

                    Et enfin, es-tu sûr que tes cellules sont vraiment vides?
                    Est-ce le résultat d'une extraction, ou d'une formule?
                    Est-ce que tu remplis à la main?

                    @ te relire
                    0
                    1. Je souhaite que ça commence à partir de Q7 jusqu'à la derniére cellule de Q en fonction de Range("K65536").End(xlUp).Row

                      C'est le résultat d'une formule que je colle en Pastespecial.

                      En fait dans mon fichier j'ai surtout des majuscules, mais il peut y avoir aussi des minuscules: ex: EFT2, EFT4, eft5, BANK, bank, PIN65, PIN79, etc

                      Tout me parait également ok dans la syntaxe des blanks, mais ça n'a pas d'incidence sur le fichier, sauf sur mon entête c'est a dire de Q2 à Q5, il m'écrit COLLECTED alors qu'il n'y a rien dans la colonne F. Bizarre...
                      As tu une idée?

                      Souhaiterais tu que je joigne ici un xls?
                      0
                      1. Re-,

                        Souhaiterais tu que je joigne ici un xls?


                        Oui, ce ne serait pas une mauvaise idée....

                        Utilise un site tel cijoint, ou cjoint

                        @ te relire
                        0
                        1. Et voilà :)

                          http://www.cijoint.fr/cjlink.php?file=cj201101/cij1U1JeZe.xlsm
                          0
                          1. Je suis désolé ennasual, mais je suis au niveau petit débutant VBA, je ne peux donc malheureusement pas t'aider :)
                            0
                            1. Bonjour,

                              Scuse pour le délai, mais étant en Nouvelle-Calédonie, le décalage horaire, plus une pré-alerte cyclonique, ben, c'est pas facile...

                              J'ai regardé ton fichier....

                              Quelques petites remarques :

                              - les cellules qui te semblent vides dans la colonne Q, ben, elles ne le sont pas tout à fait, ceci étant sûrement du au collage spécial...
                              - en colonne F, je ne vois point de "NCOP", mais plutôt du "NCOD"...

                              Donc, avec ce code, il me semble que cela fonctionne (je dis bien semble, ne sachant si tu as bien donné toutes les variables correctes....)

                              Option Compare Text
                              Private Sub CommandButton5_Click()
                              Dim Cel As Range
                              Dim DerLig As Long, I As Long
                              Dim Tblo
                              DerLig = Range("K65536").End(xlUp).Row
                              Tblo = Range("Q7:Q" & DerLig).Value
                              Range("Q7:Q" & DerLig).Value = Tblo
                              For I = DerLig To 7 Step -1
                                  Set Cel = Cells(I, "Q")
                                  If Cel = "." Then
                                      Cel.EntireRow.Delete
                                  ElseIf IsEmpty(Cel) And Cel.Offset(, -11) = "NCOD" Then
                                      Cel = 88888
                                  ElseIf IsEmpty(Cel) And Cel.Offset(, -11) <> "NCOD" Then
                                      Cel = "COLLECTED"
                                  ElseIf Cel Like "eft*" Or Cel Like "bank*" Or Cel Like "pin*" Or Cel Like "cc*" Or Cel Like "91*" Then
                                      Cel = "COLLECTED"
                                  ElseIf Cel Like "q*" Or Cel Like "over*" Or Cel Like "log*" Or Cel Like "cust*" Or Cel Like "cas*" Or Cel Like "impnd*" Then
                                      Cel = "AFODT SSC"
                                  End If
                                  If Left(Cel.Offset(, -16), 2) = "1Z" And (Cel.Offset(, -15) = 75 Or Cel.Offset(, -15) = 76 Or Cel.Offset(, -15) = 77 _
                                          Or Cel.Offset(, -15) = 79 Or Cel.Offset(, -15) = "CR") Then
                                      Cel.Offset(, -7) = "Wrong Shipment Type"
                                  End If
                              Next I
                              End Sub


                              Maintenant, pour mettre en rouge, lorsque la cellule de la colonne J équivaut à "Wrong......", regarde au niveau des mises en forme conditionnelles...

                              Bon courage
                              0
                              1. Aucun souci, grand merci!

                                J'ai change le code en mettant des majuscules car dans mon fichier dans la majeure partie des cas, les ref sont en majuscule. Dommage cependant, les minuscules ne sont plus prises en compte (pin, bank, cc...) ou meme les mix (Pin, bAnK, cC...).

                                La casse pose toujours probleme, cela fonctionne chez toi?

                                En dehors de ca ca marche du tonnerre, MERCI!
                                0
                                1. Bonjour,

                                  J'ai bien effectué les essais sur ton fichier, et quelle que soit la casse, il n'y a pas de problème.....

                                  L'Option Compare Text sert à cela...

                                  Regarde le fichier joint, j'ai recopié la colonne Q dans la colonne R, afin de pouvoir visualiser les modifications...
                                  Si dans la colonne R, la cellule est en rouge, normalement, la police sera rouge dans cette ligne
                                  Si dans la colonne R, la cellule est en jaune, cela veut dire qu'il y a des minuscules et/ou majuscules, et tu verras ainsi que tout est pris en compte....

                                  Bon courage

                                  http://www.cijoint.fr/cjlink.php?file=cj201101/cijIrZSIj8.zip
                                  0