Boucle ne fonctionne pas

**Stanler** · 31/05/2016, 14h54

Bonjour à tous,

J'ai un tableau (3.000 lignes) dont le contenu varie à chaque fois que le l'ouvre.
Je dois corriger les erreurs sur la colonne L (numéro 12), en m'aidant des colonnes G (numéro 7) et K (numéro 11).

S'il y a le mot "Hors" ou "Baleine" dans la colonne G ET le mot "toto", "tata" ou "tonton" dans la colonne k, alors je dois écrire "OK" dans la colonne "L".

Les mots "Hors", "Baleine", "toto", "tata", "tonton" peuvent être suivis ou précédés de caractères aléatoires.

Je cherche donc à faire fonctionner cette boucle :

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
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
 Sub Corrections()
 With Application
        .Cursor = xlWait
        .ScreenUpdating = False
        .DisplayStatusBar = False
        .Calculation = xlCalculationManual
        .EnableEvents = False
    End With
 
    Sheets("feuil1").Select
 
    Dim Ws As Worksheet
 
    Dim NomTable As String
 
    NomTable = "Table1"
 
    Set Ws = Worksheets("feuil1")
 
        With Ws
            .ListObjects.Add(xlSrcRange, .Range("$A$1").CurrentRegion, , xlYes).Name = NomTable
            .ListObjects(NomTable).TableStyle = "TableStyleLight9"
        End With
 
    nblignes = Range("Table1").Rows.Count + 1
 
            'Détermine LCher comme le nombre de la ligne en cours de traitement
            For LCher = 2 To nblignes
 
                a = CStr(Cells(LCher, 7))
                c = CStr(Cells(LCher, 11))
                d = CStr(Cells(LCher, 12))
 
                If a Like "*Hors*" And c Like "toto*" Then
                d = "OK"
                End If
                If a Like "*Hors*"  And c Like "*TOTO*" Then
                d = "OK"
                End If
                If a Like "*Hors*" And c Like "tata*" Then
                d = "OK"
                End If
                If a Like "*Hors*" And c Like "*TATA*" Then
                d = "OK"
                End If
                If a Like "*Hors*" And c Like "tonton*" Then
                d = "OK"
                End If
                If a Like "*Hors*" And c Like "*TONTON*" Then
                d = "OK"
                End If
                If a Like "*baleine*" and c Like "*toto*" Then
                d = "OK"
                If a Like "*baleine*" and c Like "*TOTO*" Then
                d = "OK"
                If a Like "*baleine*" and c Like "*tata*" Then
                d = "OK"
                If a Like "*baleine*" and c Like "*TATA*" Then
                d = "OK"
                If a Like "*baleine*" and c Like "*tonton*" Then
                d = "OK"
                If a Like "*baleine*" and c Like "*TONTON*" Then
                d = "OK"
            Next LCher
 
            Worksheets("Titu+Contr").ListObjects(NomTable).Unlist
 
    With Application
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
        .DisplayStatusBar = True
        .CutCopyMode = False
        .ScreenUpdating = True
        .Cursor = xlDefault
    End With
 
 End Sub

.

Je n'ai pas de code d'erreur d'exécution de la macro mais celle ci ne corrige pas les erreurs que je souhaite corriger.
Merci d'avance

**Marc-L** · 31/05/2016, 15h00

Bonjour,

tu as oublié plein de End If et certainement des Else !

A noter que pour une seule instruction après le Then elle peut être située sur la même ligne
et alors pas besoin de la ligne End If … Cf aide VBA de If.

Voir aussi l'aide VBA de l'instruction Select Case.

_________________________________________________________________________________________________________
Je suis Paris, Charlie, Bruxelles, …

**Kiouane** · 31/05/2016, 15h12

Pour moi ton code je le verrais plutôt de cette façon :

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
Sub x()
 
n = Range("G" & Rows.Count).End(xlUp).Row
For Each Cell In Range(Cells(2, 12), Cells(n, 12))
 
    If Cell.Offset(0, -5) Like "*Hors*" Or Cell.Offset(0, -5) Like "*Baleine*" Then
 
       If Cell.Offset(0, -1).Value Like "*Toto*" Or Cell.Offset(0, -1) Like "*Tonton*" Or Cell.Offset(0, -1) Like "*Tata*" Then
       Cell.Value = "Ok"
       End If
 
    End If
 
Next
 
End Sub

**Stanler** · 31/05/2016, 15h15

Bonjour,

En effet !

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
60
61
62
63
64
65
66
67
68
69
70
71
Sub Corrections()
 With Application
        .Cursor = xlWait
        .ScreenUpdating = False
        .DisplayStatusBar = False
        .Calculation = xlCalculationManual
        .EnableEvents = False
    End With
 
    Sheets("feuil1").Select
 
    Dim Ws As Worksheet
 
    Dim NomTable As String
 
    NomTable = "Table1"
 
    Set Ws = Worksheets("feuil1")
 
        With Ws
            .ListObjects.Add(xlSrcRange, .Range("$A$1").CurrentRegion, , xlYes).Name = NomTable
            .ListObjects(NomTable).TableStyle = "TableStyleLight9"
        End With
 
    nblignes = Range("Table1").Rows.Count + 1
 
            'Détermine LCher comme le nombre de la ligne en cours de traitement
            For LCher = 2 To nblignes
 
                a = CStr(Cells(LCher, 7))
                c = CStr(Cells(LCher, 11))
                d = CStr(Cells(LCher, 12))
 
                If a Like "*Hors*" And c Like "toto*" Then d = "OK"
                End If
                If a Like "*Hors*"  And c Like "*TOTO*" Then d = "OK"
                End If
                If a Like "*Hors*" And c Like "tata*" Then d = "OK"
                End If
                If a Like "*Hors*" And c Like "*TATA*" Then d = "OK"
                End If
                If a Like "*Hors*" And c Like "tonton*" Then d = "OK"
                End If
                If a Like "*Hors*" And c Like "*TONTON*" Then d = "OK"
                End If
                If a Like "*baleine*" and c Like "*toto*" Then d = "OK"
                End If
                If a Like "*baleine*" and c Like "*TOTO*" Then d = "OK"
                End If
                If a Like "*baleine*" and c Like "*tata*" Then d = "OK"
                End If
                If a Like "*baleine*" and c Like "*TATA*" Then d = "OK"
                End If
                If a Like "*baleine*" and c Like "*tonton*" Then d = "OK"
                End If
                If a Like "*baleine*" and c Like "*TONTON*" Then d = "OK"
                End If
            Next LCher
 
            Worksheets("Titu+Contr").ListObjects(NomTable).Unlist
 
    With Application
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
        .DisplayStatusBar = True
        .CutCopyMode = False
        .ScreenUpdating = True
        .Cursor = xlDefault
    End With
 
 End Sub

Je me renseigne sur le Select...Case

Merci pour ta réponse Kiouane,

J'ai testé ton code sur mon fichier, mais là encore il n'y a aucun changement

**Kiouane** · 31/05/2016, 15h19

Je l'ai testé avant de le poster. Assure toi des colonnes. C'est bien les colonnes G et K comme référence et L à corriger?

**casefayere** · 31/05/2016, 15h20

j'ajouterai, avec Like, prévoir avant le code "Option Compare Text" au dessus du module pour indifferencier les majuscules des minuscules

**Stanler** · 31/05/2016, 15h23

Ce sont bien les colonnes G et K comme référence et la colonne L à corriger.

Il y a peut être un format de cellule à appliquer à la colonne.
Oui, j'ai parfois des majuscules et parfois des minuscules, merci casefayere

Ca y est ! Ca fonctionne grâce au code de Kiouane et grâce à "Option Compare Text" avant le code !

Merci à tous les trois ^^

**Kiouane** · 31/05/2016, 15h26

Je suis curieux, je voudrais savoir la raison pour laquelle il ne fonctionne pas pour toi. Peux-tu mettre un fichier exemple si ne contenant pas de données confidentielles?

Edit : Ah d'accord, tu me rassures

!

**Stanler** · 31/05/2016, 15h28

Kiouane,

Avais tu mis des majuscules dans tes tests ?
Je peux avoir des combinaisons tel que : "Baleine" ; "HorS" ; "BALEINE" ; "baleine"; "HORS baleine"...

Je crois que c'est ce qui n'allait pas parce que grâce à l'option compare text, ton code fonctionne !

**Kiouane** · 31/05/2016, 15h30

Ah d'accord, en effet c'était ça la raison, je pensais que tes textes était fixes avec une majuscule au début. Merci pour l'info en tout cas Case

et à toi aussi Stan.

Edit : N'oublies pas de mettre la discussion comme résolue :p !

Boucle ne fonctionne pas

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager