Select Case For

Version imprimable

Select Case For

Bonjour,
Cela fait des heures aue je bute sur un problème.
J'ai des valeurs de type texte dans les cellules de ma colonne C.
Je voudrais remplacer ces valeurs de la sorte:

Clio --> renault
Megane -->renault
Laguna-->renault
308-->peugeot
A3-->audi
207-->peugeot
A4-->bmw

Je pense que pour se faire il faut que utiliser une boucle for combiner avec un Select case mais je n'arrive pas à incorporer la boucle FOR dedans.
Code:

1 2 3 4 5 6 7 8 9 Select Case Case "Clio*" 'tout ce aui commence par Clio .Value = "Renault" Case "A3*" .Value = "Audi" Case "207" .value = "Peugeot" 'etc.... End Select

Bonjour,

Code:

1
2
3
4
5
6
7
8
    Dim Marques, Modèles, Quoi As String, Trouve As String
    Marques = Array("Renault", "Renault", "Renault", "Peugeot", "Audi", "Peugeot", "BMV")
    Modèles = Array("Clio", "Megane", "Laguna", "308", "A3", "207", "A4")
    Quoi = InputBox("Entrez le modèle")
    With Application
        Trouve = .Index(Marques, .Match(Quoi, Modèles, 0))
        MsgBox Trouve
    End With

Si tu utilises "Select Case", tu dois préciser une variable :

Code:

Select Case Modèle

20/11/2013, 16h25
John Parker

Bonjour et merci pour ta réponse.
Je me suis peut être mal exprimé, les valeurs de la colonne C contenant les modèles de véhicule évoluent en permanence.
J'aimerai que:

-pour toutes cellules de la colonne C contenant "Laguna", le code me remplace "Laguna" par "Renault"

-pour toutes cellules de la colonne C contenant "Clio", le code me remplace "Clio" par "Renault"

-pour toutes cellules de la colonne C contenant "207", le code me remplace "207" par "Peugeot"

-etc etc

Merci

Ce code fonctionne tant que les modèles numériques sont entrés au format texte :

Code:

1
2
3
4
5
6
7
8
    Dim Marques, Modèles, C As Range
    Marques = Array("Renault", "Renault", "Renault", "Peugeot", "Audi", "Peugeot", "BMV")
    Modèles = Array("Clio", "Megane", "Laguna", "308", "A3", "207", "A4")
    With Application
        For Each C In Range([C1], Cells(Rows.Count, 3).End(xlUp))
            C.Value = .Index(Marques, .Match(C.Value, Modèles, 0))
        Next C
    End With

20/11/2013, 16h49
John Parker

Il fonctionne en effet. Cependant, j'ai oublié de préciser qu'il est possible que j'ai des données au'il ne faut pas remplacer. Le problème de cette macro est que si le mot n'est pas trouvé alors j'ai #N/A. Il faudrait aue si le mot n'est pas trouvé alors on laisse celui contenu dans la cellule.
De plus, dans le cas des clio, est-il possible de remplacer tous les mots contenant "Clio" par "Renault" étant donné qu'il y a le cas des Clio II, Clio III, Clio IV...

Merci encore

Citation:

j'ai oublié de préciser qu'il est possible que j'ai des données au'il ne faut pas remplacer.

Oui, lesquelles ?

Code:

1
2
3
4
5
6
7
8
9
10
    Dim Marques, Modèles, C As Range
    Marques = Array("Peugeot", "Peugeot", "Audi", "BMV", "Renault", "Renault", "Renault")
    Modèles = Array("207", "308", "A3", "A4", "Clio", "Laguna", "Megane")
    With Application
        For Each C In Range([C1], Cells(Rows.Count, 3).End(xlUp))
            If IsNumeric(.Match(C.Value, Modèles)) Then
                C.Value = .Index(Marques, .Match(C.Value, Modèles))
            End If
        Next C
    End With

20/11/2013, 18h35
Invité

Bonsoir,

tu peux utiliser une autre feuille qui match les modèles avec les marques.
ainsi tu ne bloque pas ton code à ce qui existe et de plus il est évolutif.

si le modèle n'existe pas dans la feuille ModèlesMarques tu ne replace rien.
21/11/2013, 08h56
John Parker

Justement mon soucis est que je ne peux pas te dire tous les modèles. J'aimerais remplacer uniquement ceux indiquer.

Je ne comprends pas bien ton histoire de rajouter une feuille?
21/11/2013, 09h15
illight

Je vais répondre à sa place, mais si tu créé une feuille avec toutes tes correspondances entre le modèle et la marque, des simples RECHERCHEV régleront ton problème :)
Après avoir effectué tes recherchev, et fait un copier/coller valeur, tu n'aura plus qu'à supprimer ta première colonne si tu veux vraiment remplacer :)
21/11/2013, 11h38
John Parker

Bonjour,

J'ai déjà pensé au RECHERCHEV, le problème est que mes données sont importées et donc change continuellement. Je ne dois remplacer que quelques modèles bien définis par la marque. Les autres ne doivent pas bouger et je ne les connais pas nécessairement

Je ne sais pas si ça vous aide à comprendre mon problème?
21/11/2013, 12h45
Invité

bojour,

tu peux faire une recherche par macro, la si un occurrence est trouvé, tu replace le modèle par la marque.

http://www.developpez.net/forums/d13...e/#post7495019
21/11/2013, 12h48
John Parker

Merci pour ta réponse, j'ai suivi ton conseil et entré sur cette même feuille les modèles en BA et les marques en BC mais comment faire une recherche remplacé?

Encore merci de prendre le temps de répondre ;)

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
 
 
Function SerchXls(MyRange As Range, MyCellule As Range, strRecherche, EntierCell As Boolean) As Long '
On Error Resume Next
SerchXls = 0
Dim myxLookAt As Integer
If EntierCell = True Then myxLookAt = xlWhole Else myxLookAt = xlPart
   SerchXls = MyRange.Cells.Find(What:=strRecherche, After:=MyCellule, LookIn:=xlFormulas, LookAt _
        :=myxLookAt, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, MatchByte:=False).Row
  If SerchXls <= MyCellule.Row Then SerchXls = 0
End Function
 
 
Sub scanner()
Dim MyRange As Range
Dim I As Long
    Dim scan As String
    Dim ligne As Long
    Application.EnableEvents = False
    Set MyRange = ActiveWorkbook.Worksheets("Feuil1").UsedRange
    For I = 2 To MyRange.Rows.Count
        If Trim("" & MyRange(I, 1)) <> "" Then
            ligne = SerchXls(ActiveWorkbook.Worksheets("ModèlesMarques").Columns("A:A"), ActiveWorkbook.Worksheets("ModèlesMarques").Range("A1"), MyRange(I, 1), True)
            If ligne > 0 Then MyRange(I, 1) = ActiveWorkbook.Worksheets("ModèlesMarques").Cells(ligne, 2)
        End If
    Next
    Application.EnableEvents = True
 
End Sub

22/11/2013, 12h09
John Parker

C'est niquel ça marche parfaitement après l'avori adapté à mon tableau.
Je voulais te demander s'il est possible de rajouter un autre test (surement imbriauer une autre boucle). Dans ma feuille "ModèleMarque" j'ai une 3ème colonne catégorie. Le but est que si une des valeurs de la colonne catégorie est trouvée alors on supprime la valeur de la cellule concernée?

En tout cas je te remercie infiniment!

Je me suis débrouillé autrement. Il m'a suffit de mettre une case vide pour la colonne de remplacement...
Du coup un grand merci à vous tous!
J'aurai tout de même bien aimé savoir comment remplacer les tout ce qui contient "Clio" par exemple par "Renault", tout ce aui contient "Classe" par "Mercedes"

bonjour,

désolé pour mon manque de réactivité, mais je suis très chargé en ce moment.

si tu recherche une phrase entière:

Code:

ligne = SerchXls(ActiveWorkbook.Worksheets("ModèlesMarques").Columns("A:A"), ActiveWorkbook.Worksheets("ModèlesMarques").Range("A1"), MyRange(I, 1), True)

si tu recherche un fragment de phrase:

Code:

ligne = SerchXls(ActiveWorkbook.Worksheets("ModèlesMarques").Columns("A:A"), ActiveWorkbook.Worksheets("ModèlesMarques").Range("A1"), MyRange(I, 1), False)

avec prise en compte de la catégorie:

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
 
 
Function SerchXls(MyRange As Range, MyCellule As Range, strRecherche, EntierCell As Boolean) As Long '
On Error Resume Next
SerchXls = 0
Dim myxLookAt As Integer
If EntierCell = True Then myxLookAt = xlWhole Else myxLookAt = xlPart
   SerchXls = MyRange.Cells.Find(What:=strRecherche, After:=MyCellule, LookIn:=xlFormulas, LookAt _
        :=myxLookAt, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, MatchByte:=False).Row
  If SerchXls <= MyCellule.Row Then SerchXls = 0
End Function
 
 
Sub scanner()
Dim MyRange As Range
Dim I As Long
    Dim scan As String
    Dim ligne As Long
    Dim SaveLinge As Long
    Dim catégorieOk As Boolean
    Dim QuitteSerchXls As Boolean
    Dim Trouve As Boolean
    Application.EnableEvents = False
    Set MyRange = ActiveWorkbook.Worksheets("Feuil1").UsedRange
    For I = 2 To MyRange.Rows.Count
        If Trim("" & MyRange(I, 1)) <> "" Then
            ligne = 0: SaveLinge = 1: QuitteSerchXls = False: catégorieOk = False
             While QuitteSerchXls = False
                SaveLinge = SerchXls(ActiveWorkbook.Worksheets("ModèlesMarques").Columns("A:A"), ActiveWorkbook.Worksheets("ModèlesMarques").Range("A" & SaveLinge), MyRange(I, 1), True)
 
                If SaveLinge = 0 Then QuitteSerchXls = True
 
                If SaveLinge > 0 And Trouve = False Then
                    Trouve = True
                    ligne = SaveLinge
                End If
 
               If SaveLinge > 0 And Trouve = True Then
                   If MyRange(I, 3) = ActiveWorkbook.Worksheets("ModèlesMarques").Cells(SaveLinge, 3) Then
                        ligne = SaveLinge
                        catégorieOk = True
                        QuitteSerchXls = True
                   End If
 
               End If
             Wend
 
 
            If ligne > 0 Then MyRange(I, 1) = ActiveWorkbook.Worksheets("ModèlesMarques").Cells(ligne, 2)
                If ligne > 0 And catégorieOk = True Then
                    'ton traitement.
                End If
        End If
    Next
    Application.EnableEvents = True
 
End Sub

22/11/2013, 13h45
John Parker

Super merci beaucoup pour ton aide!
Il n'est donc pas possible d'utiliser simplement un caractère joker?
22/11/2013, 13h51
Invité

si tu utilise l'exemple du fragment de phrase si tu entre "Class" et qu'il existe dans la feuille "ModèlesMarques" "ClassA" elle serra prise en compte.

je pense que "cl*ss" marche à vérifier.
22/11/2013, 15h38
John Parker

Ca marche parfaitement je te remercie. Je vais tester le caractère joker

Encore merci :D