Select Case For

**John Parker** · 20/11/2013, 15h38

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

**Daniel.C** · 20/11/2013, 16h15

Bonjour,

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

Select Case Modèle

**John Parker** · 20/11/2013, 16h25

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

**Daniel.C** · 20/11/2013, 16h36

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

**John Parker** · 20/11/2013, 16h49

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

**Daniel.C** · 20/11/2013, 17h48

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

Invité · 20/11/2013, 18h35

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.

**John Parker** · 21/11/2013, 08h56

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?

**illight** · 21/11/2013, 09h15

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

**John Parker** · 21/11/2013, 11h38

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?

Invité · 21/11/2013, 12h45

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

**John Parker** · 21/11/2013, 12h48

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

Invité · 21/11/2013, 13h17

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

**John Parker** · 22/11/2013, 12h09

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"

Invité · 22/11/2013, 12h39

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

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

**John Parker** · 22/11/2013, 13h45

Super merci beaucoup pour ton aide!
Il n'est donc pas possible d'utiliser simplement un caractère joker?

Invité · 22/11/2013, 13h51

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.

**John Parker** · 22/11/2013, 15h38

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

Encore merci

Select Case For [XL-2010]

Macros et VBA Excel

Discussions similaires

Partager

Partager