VBA Remplir cellule sur critères

Question

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.





Configuration: Windows XP / Firefox 3.6.13

ERIC71PL · Answer

Quelqu'un pour m'aider? Merci

michel_m · Answer

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

cousinhub29 · Answer

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

ennasual · Answer

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 :)

ERIC71PL · Answer

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.

cousinhub29 · Answer

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

ERIC71PL · Answer

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.

cousinhub29 · Answer

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

ERIC71PL · Answer

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"

:/

cousinhub29 · Answer

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

ERIC71PL · Answer

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?

cousinhub29 · Answer

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

ERIC71PL · Answer

Et voilà :)

http://www.cijoint.fr/cjlink.php?file=cj201101/cij1U1JeZe.xlsm

ERIC71PL · Answer

Je suis désolé ennasual, mais je suis au niveau petit débutant VBA, je ne peux donc malheureusement pas t'aider :)

ERIC71PL · Answer

Une bonne ame pour m'aider? :)

cousinhub29 · Answer

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

ERIC71PL · Answer

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!

cousinhub29 · Answer

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

VBA Remplir cellule sur critères

18 réponses

Votre réponse

Discussions similaires

Newsletters