Ajout d'un mot selon certaines conditions

Le 19/12/2011 à 13:23

Bonjour a vous,

Je voudrais une macro qui en cellule A17, rajoute un mot (,macho ou ,hembra) selon si dans cette même case (A17) case il y ai:

Pour Macho:

FLIP ALDO FK REMS CLINEX KO ZORO 2F COJAK ALPHA MERT DIGIT QAZI FRER MONO G403 LIPS BOITE ARTHUR VIN BO PELE L10 AL M20 NEZ P40

Pour hembra:

E66 2L NARINE O203 PP PIRAT 274 277 EPIS Z A330 NEIG MA ALPHAF DIANA 2T 360 PUNK G400 MARILIN L11 M21 O30 FOFOL

Merci à vous d'avance

Le 19/12/2011 à 13:39

Salut,

Peux tu joindre un fichier d'exemple ?

J'avoue ne pas très bien comprendre ta demande.

Tu veux remplacer dans la Cellule A17 qui contient :

FLIP ALDO FK REMS CLINEX KO ZORO 2F COJAK ALPHA MERT DIGIT QAZI FRER MONO G403 LIPS BOITE ARTHUR VIN BO PELE L10 AL M20 NEZ P40 par le mot 'Macho'

ou remplacer

E66 2L NARINE O203 PP PIRAT 274 277 EPIS Z A330 NEIG MA ALPHAF DIANA 2T 360 PUNK G400 MARILIN L11 M21 O30 FOFOL

par 'hembra'

Ou alors tu veux ajouter les mots a la suite ?

FLIP ALDO FK REMS CLINEX KO ZORO 2F COJAK ALPHA MERT DIGIT QAZI FRER MONO G403 LIPS BOITE ARTHUR VIN BO PELE L10 AL M20 NEZ P40 - >

FLIP ALDO FK REMS CLINEX KO ZORO 2F COJAK ALPHA MERT DIGIT QAZI FRER MONO G403 LIPS BOITE ARTHUR VIN BO PELE L10 AL M20 NEZ P40 Macho

Besoin de plus d'info.

Bigdams

Le 19/12/2011 à 13:43

Bonjour

Bonjour Bigdams

J'ai compris si la cellule A17 contient 1 de ces mots, rajouter .....

la macro dans ce sens

Sub truc()
Dim Macho
Dim Hembra
Dim I As Integer

  Macho = Array("FLIP", "ALDO", "FK", "REMS", "CLINEX", "KO", "ZORO", "2F", "COJAK", "ALPHA", _
                "MERT", "DIGIT", "QAZI", "FRER", "MONO", "G403", "LIPS", "BOITE", "ARTHUR", _
                "VIN", "BO", "PELE", "L10", "AL", "M20", "NEZ", "P40")
  Hembra = Array("E66", "2L", "NARINE", "O203", "PP", "PIRAT", "274", "277", "EPIS", "Z", _
                 "A330", "NEIG", "MA", "ALPHAF", "DIANA", "2T", "360", "PUNK", "G400", _
                 "MARILIN", "L11", "M21", "O30", "FOFOL")

  With Range("A17")
    For I = 0 To UBound(Macho)
      If UCase(.Value) = Macho(I) Then .Value = .Value & ",macho": Exit Sub
    Next I
    For I = 0 To UBound(Hembra)
      If UCase(.Value) = Hembra(I) Then .Value = .Value & ",Hembra": Exit Sub
    Next I
  End With
End Sub
Le 19/12/2011 à 19:35

L'idée est bien celle là banzai64, mais quant je lance la macro rien ne se produit.

J'envoie un exemple en espérant que cela puisse aider.

190108-alphaf.csv (1.95 Ko)
Le 19/12/2011 à 21:39

Bonsoir,

Oui c'est normal dans le code de Banzai64, on compare la valeur de la cellule avec un des mots de la liste contenu dans le tableau.

Or dans ton exemple on a :

A17 = (0108, ALPHAF)

En fait tu veux savoir si le mot est contenu dans la cellule, dans ce cas il faut utiliser l'instruction InStr

Dans ton cas tu peux utiliser la macro de Banzai64 en modifiant les lignes suivantes :

Banzai64 :

If UCase(.Value) = Macho(I) Then .Value = .Value & ",macho": Exit Sub

If UCase(.Value) = Hembra(I) Then .Value = .Value & ",Hembra": Exit Sub

par

If InStr(1, UCase(.Value), Macho(I)) > 0 Then .Value = .Value & ",macho": Exit Sub

If InStr(1, UCase(.Value), Hembra(I)) > 0 Then .Value = .Value & ",Hembra": Exit Sub

Tu auras pour résultat : A17 = (0108, ALPHAF),macho

Si tu souhaites avoir le résultat entre parenthèses:(A17 = (0108, ALPHAF,macho)

If InStr(1, UCase(.Value), Macho(I)) > 0 Then .Value = Left(.Value, Len(.Value) - 1) & ",macho)": Exit Sub

If InStr(1, UCase(.Value), Hembra(I)) > 0 Then .Value = Left(.Value, Len(.Value) - 1) & ",Hembra)": Exit Sub

Dis moi si c'est bon ?

++

Big

Le 19/12/2011 à 22:25

Bonsoir

J'ai modifié la macro pour tenir compte des nouvelles contraintes

Mais cette macro fonctionnera si les données sont toujours dans le même style

Présence ou absence de "(" (parenthèse ouvrante)

Présence ou absence de ")" (parenthèse fermante)

Données séparées par une , (virgule)

Sub truc()
Dim Macho
Dim Hembra
Dim I As Integer
Dim K As Integer
Dim Tablo

  Macho = Array("FLIP", "ALDO", "FK", "REMS", "CLINEX", "KO", "ZORO", "2F", "COJAK", "ALPHA", _
                "MERT", "DIGIT", "QAZI", "FRER", "MONO", "G403", "LIPS", "BOITE", "ARTHUR", _
                "VIN", "BO", "PELE", "L10", "AL", "M20", "NEZ", "P40")
  Hembra = Array("E66", "2L", "NARINE", "O203", "PP", "PIRAT", "274", "277", "EPIS", "Z", _
                 "A330", "NEIG", "MA", "ALPHAF", "DIANA", "2T", "360", "PUNK", "G400", _
                 "MARILIN", "L11", "M21", "O30", "FOFOL")

  With Range("A17")
    Tablo = Split(Replace(Replace(.Value, "(", ""), ")", ""), ",")
    For I = 0 To UBound(Macho)
      For K = 0 To UBound(Tablo)
        If Trim(UCase(Tablo(K))) = Macho(I) Then .Value = .Value & ",macho": Exit Sub
      Next K
    Next I
    For I = 0 To UBound(Hembra)
      For K = 0 To UBound(Tablo)
        If Trim(UCase(Tablo(K))) = Hembra(I) Then .Value = .Value & ",hembra": Exit Sub
      Next K
    Next I
  End With
End Sub
Le 19/12/2011 à 22:44

c'est super, par contre le nom se rajoute après la parenthèse et il vaudrais que se soit à l'intérieur. Donc soit faire en sorte que la case 17 n'est pas de parenthèse fermante (au quel cas je peut le faire mais que dois-je modifier dans le code que tu ma donnée), soit fair en sorte que sa le rajoute dans la parenthèse.

Je suis vraiment désolé de ne pas avoir expliqué plus précisément dès le départ, excuse moi.

C'est bon, j'ai fait en sorte que la case 17 n'est pas de parenthèse fermante, sa l'aire de fonctionner, je te remercie pour ton efficacité.

Juste si tu pense que c'est une mauvaise idée, fait le moi savoir.

Merci encore.

Le 19/12/2011 à 22:59

Bonsoir

Pourquoi sans enlever la parenthèse tu ne prendrais pas la bonne idée de Bigdams

Macro modifiée

Sub truc()
Dim Macho
Dim Hembra
Dim I As Integer
Dim K As Integer
Dim Tablo

  Macho = Array("FLIP", "ALDO", "FK", "REMS", "CLINEX", "KO", "ZORO", "2F", "COJAK", "ALPHA", _
                "MERT", "DIGIT", "QAZI", "FRER", "MONO", "G403", "LIPS", "BOITE", "ARTHUR", _
                "VIN", "BO", "PELE", "L10", "AL", "M20", "NEZ", "P40")
  Hembra = Array("E66", "2L", "NARINE", "O203", "PP", "PIRAT", "274", "277", "EPIS", "Z", _
                 "A330", "NEIG", "MA", "ALPHAF", "DIANA", "2T", "360", "PUNK", "G400", _
                 "MARILIN", "L11", "M21", "O30", "FOFOL")

  With Range("A17")
    Tablo = Split(Replace(Replace(.Value, "(", ""), ")", ""), ",")
    For I = 0 To UBound(Macho)
      For K = 0 To UBound(Tablo)
        If Trim(UCase(Tablo(K))) = Macho(I) Then .Value = Left(.Value, Len(.Value) - 1) & ",macho)": Exit Sub
      Next K
    Next I
    For I = 0 To UBound(Hembra)
      For K = 0 To UBound(Tablo)
        If Trim(UCase(Tablo(K))) = Hembra(I) Then .Value = Left(.Value, Len(.Value) - 1) & ",hembra)": Exit Sub
      Next K
    Next I
  End With
End Sub
Le 19/12/2011 à 23:25

Désolé j'avais pas vue, en tout cas je vous remercie a tout les deux pour ces macro maintenant il me reste plus qu'a comprendre ces lignes de commandes

Rechercher des sujets similaires à "ajout mot certaines conditions"