IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

Remplir une cellule si valeur trouvée dans une autre cellule [XL-2010]


Sujet :

Macros et VBA Excel

  1. #1
    Futur Membre du Club
    Homme Profil pro
    Étudiant
    Inscrit en
    Novembre 2013
    Messages
    8
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations professionnelles :
    Activité : Étudiant
    Secteur : Industrie

    Informations forums :
    Inscription : Novembre 2013
    Messages : 8
    Points : 6
    Points
    6
    Par défaut Remplir une cellule si valeur trouvée dans une autre cellule
    Bonjour,
    Je possède un tableau avec 3 colonnes mais une très grande quantité de ligne(plus de 10k), j'aimerai a partir d'une macro vérifier par exemple dans la colonne C si une cellule contient "azerty" et donc écrire en colonne D mais sur la même ligne que la cellule ou le mot a été trouver "clavier" car j'ai classer des mots par famille, exemple:

    ...C................D
    azerty.........clavier
    azerty.........clavier
    qwerty.........clavier
    laser............souris
    optique.........souris

    La macro chercherait "*azerty*";"*qwerty*" en colonne C et écrirait en colonne D même ligne que la valeur trouver "clavier".
    Elle chercherait aussi "*laser*";"*optique*" en colonne C et écrirait en colonne D toujours sur la même ligne que la valeur trouver "souris".

    Je ne sais pas si cela parait clair, car cela fait déjà quelques temps que je suis dessus alors il se peut que je ne le soit pas.

    En vous remerciant par avance.

  2. #2
    Invité
    Invité(e)
    Par défaut
    Bonjour,

    Une solution possible :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    Sub TestClavierSouris()
     
    Dim ShSource As Worksheet
     
    Dim LigneTitre As Long
    Dim DerniereLigne As Long
    Dim ColonneTestee As Long
    Dim ColonneResultat As Long
     
    Dim AireTestee As Range
    Dim CelluleTestee As Range
     
     
            Set ShSource = Sheets("Feuil1")
            LigneTitre = 10
            ColonneTestee = 3
            ColonneResultat = 4
     
            With ShSource
     
                DerniereLigne = .Cells(.Rows.Count, ColonneTestee).End(xlUp).Row
                Set AireTestee = .Range(.Cells(LigneTitre + 1, ColonneTestee), .Cells(DerniereLigne, ColonneTestee))
                For Each CelluleTestee In AireTestee
                    CelluleTestee.Offset(0, ColonneResultat - ColonneTestee) = ValeurCible(CelluleTestee)
                Next CelluleTestee
                Set AireTestee = Nothing
     
            End With
     
            Set ShSource = Nothing
     
     
    End Sub
     
     
    Function ValeurCible(ByVal CelluleSource As Range) As String
     
    Dim CelluleRecherchee As Range
    Dim ValeursAChercher As Variant
    Dim I As Integer
     
            ValeurCible = ""
            ValeursAChercher = Array("azerty", "qwerty", "laser", "optique")
     
            For I = 1 To 4
                  Set CelluleRecherchee = CelluleSource.Find(what:=ValeursAChercher(I - 1), LookIn:=xlValues, lookat:=xlWhole)
                  If Not CelluleRecherchee Is Nothing Then
                         Select Case UCase(ValeursAChercher(I - 1))
                             Case "AZERTY", "QWERTY"
                                  ValeurCible = "Clavier"
                             Case "LASER", "OPTIQUE"
                                  ValeurCible = "Souris"
                        End Select
                  End If
                    Next I
     
            Set CelluleRecherchee = Nothing
     
    End Function
    Cordialement.

  3. #3
    Futur Membre du Club
    Homme Profil pro
    Étudiant
    Inscrit en
    Novembre 2013
    Messages
    8
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations professionnelles :
    Activité : Étudiant
    Secteur : Industrie

    Informations forums :
    Inscription : Novembre 2013
    Messages : 8
    Points : 6
    Points
    6
    Par défaut
    Bonjour

    Merci beaucoup pour la réponse, mais je rencontre quelques petits problèmes avec ce code.

    Lorsque je lance la macro elle ne rempli que la dernière case et pas celle au dessus.

    Je ne comprend pas a quoi sert cette ligne:

    C'est elle qui permet de définir l'air ?

    En vous remerciant par avance.

  4. #4
    Invité
    Invité(e)
    Par défaut
    Bonjour,

    Le code est pourtant assez explicite. Il s'agit de la ligne de titre. Si votre ligne de titre est sur la première ligne : LigneTitre = 1

    Mes tableaux commencent très souvent sur la ligne 10.....

    Cordialement.
    Dernière modification par AlainTech ; 28/04/2014 à 00h53. Motif: Suppression de la citation inutile

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. [XL-2013] Copier cellules en ligne dans une colonne qui se trouve dans un autre classeur
    Par Wushugringo dans le forum Macros et VBA Excel
    Réponses: 2
    Dernier message: 20/02/2015, 08h07
  2. Réponses: 2
    Dernier message: 02/04/2008, 19h55
  3. Réponses: 1
    Dernier message: 16/05/2007, 12h51
  4. Donner à une feuille la valeur contenue dans une cellule ?
    Par emilie_pons_2005 dans le forum Macros et VBA Excel
    Réponses: 1
    Dernier message: 11/09/2006, 12h32
  5. Réponses: 3
    Dernier message: 13/06/2006, 16h36

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo