Remplir une cellule si valeur trouvée dans une autre cellule

Version imprimable

16/04/2014, 10h25
Beerzebub

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.

Bonjour,

Une solution possible :

Code:

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.

17/04/2014, 11h27
Beerzebub

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:

Code:

LigneTitre = 10

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

En vous remerciant par avance.
17/04/2014, 11h33
Invité

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.